home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / node2src.zip / RBBSSUB5.BAS < prev    next >
BASIC Source File  |  1990-12-31  |  117KB  |  3,384 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB5.BAS CPC17.3, Copyright 1986 - 90 by D. Thomas Mack'
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB5.BAS
  5. '  First Released .....: February 4, 1990
  6. '  Subsequent Releases.: 
  7. '  Copyright ..........: 1986 - 1990
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  BinSearch      63520  Binary searches sorted file for a key value
  18. '  BreakFileName  63300  Break file name into component parts
  19. '  BufAsUnit      63500  Buffer out a string with CR's
  20. '  SetPrompt      63470  Set prompts based on the user's security
  21. '  DoorReturn     63100  Process door requests
  22. '  FdMacExe       63462  Executes a found macro
  23. '  FileSystem     20117  File System for RBBS-PC
  24. '  FindIt         63490  Check whether file exists and if so open as #2
  25. '  FormRead       63420  Read from file into a form
  26. '  LockAppend     63400  Prepare for a file append
  27. '  MacroExe       63460  Execute internal macro rather than user
  28. '  MsgNameMatch   63540  Match name to one in msg header
  29. '  NoPath         63480  Detects whether string has a path in it
  30. '  RestoreCom     63310  Restore comm port after external program
  31. '  ReadMacro      63330  Read and process macro
  32. '  ShellExit      63320  Exit RBBS via shell
  33. '  TakeOffHook    63530  Take modem off hook
  34. '  UnLockAppend   63410  Clean up after file append
  35. '  VerifyAns      63510  Verify that string passes edits
  36. '  WildCard       63200  Match string to a pattern
  37. '
  38. '  $INCLUDE: 'RBBS-VAR.BAS'
  39. '
  40. 20117 ' $SUBTITLE: 'FileSystem -- subroutine for RBBS-PC's file system'
  41. ' $PAGE
  42. '
  43. ' NAME    -- FileSystem
  44. '
  45. ' INPUTS  --       PARAMETER                 MEANING
  46. '             ZFileSysParm = 1  LIST THE SYSOP'S COMMENTS FILE
  47. '                                 2  L)IST DIRECTORY COMMAND
  48. '                                 3  D)OWNLOAD COMMAND
  49. '                                 4  RETURN FROM EXTERNAL PROTOCOLS
  50. '                                 5  U)PLOAD COMMAND
  51. '                                 6  S)CAN DIRECTORY COMMAND
  52. '                                 7  P)ERSONAL FILES COMMAND
  53. '                                 8  N)EW FILES COMMAND
  54. '                                 9  RETURN FROM EXTENDED DESCRIPTION
  55. '
  56. ' OUTPUTS -- ZFileSysParm = 1  COMMAND PROCESSED SUCCESSFULLY
  57. '                                2  RECYCLE TO TOP OF RBBS-PC (202)
  58. '                                3  PROCESS NEXT COMMAND (1200)
  59. '                                4  DENY USER ACCESS (1380)
  60. '                                5  HANDLE EXTENDED DESCRIP. (2008)
  61. '                                6  USER'S TIME EXCEEDED (10553)
  62. '                                7  Carrier DROPPED (10595)
  63. '
  64. ' PURPOSE -- To handle the RBBS-PC file system commands
  65. '
  66.       SUB FileSystem STATIC
  67.       ZFF = ZFileSysParm
  68.       ZFileSysParm = 1
  69.       ON ZFF GOSUB 20119, _  ' HANDLER TO LIST COMMENTS TO SYSOP
  70.                   20150, _  ' L)IST DIRECTORY COMMAND HANDLER
  71.                   20180, _  ' D)OWNLOAD COMMAND HANDLER
  72.                   20263, _  ' RETURN FROM EXTERNAL Protocol'S
  73.                   20400, _  ' U)PLOAD COMMAND HANDLER
  74.                   21800, _  ' S)CAN DIRECTORY COMMAND HANDLER
  75.                   21850, _  ' P)ERSONAL FILES COMMAND HANDLER
  76.                   21860, _  ' N)EW FILES COMMAND HANDLER
  77.                   20705     ' RETURN FROM EXTENDED DESCRIPTIONS
  78.       GOTO 21920
  79. 20119 ZErrCode = 0
  80.       GOTO 20122
  81. '
  82. ' *****  SCAN DIRECTORIES (PRINT TEXT)  ****
  83. '
  84. '  (formerly lines 7000 to 7260 in RBBS-PC.BAS CPC16-1ZWasA
  85. 20120 ZOutTxt$ = "Scanning Directory " + _
  86.            ZFileNameHold$
  87.       IF WasRS$ <> "" THEN _
  88.          ZOutTxt$ = ZOutTxt$ + " for " + WasRS$
  89.       GOSUB 21650
  90.       IF ZFileSysParm > 1 THEN _
  91.          RETURN
  92.       WasPG = ZTrue
  93. 20122 CALL OpenWork (2,ZFileName$)
  94.       IF ZErrCode = 53 THEN _
  95.          ZOutTxt$ = "Missing File " + ZFileName$ : _
  96.          CALL UpdtCalr (ZOutTxt$,2) : _
  97.          ZOutTxt$ = ZOutTxt$ + _
  98.               ". Please tell SYSOP" : _
  99.          GOSUB 21650 : _
  100.          RETURN
  101.       ZJumpSupported = ZTrue
  102.       ZJumpLast$ = ""
  103.       LastOK = ZFalse
  104. 20124 CALL Carrier
  105.       IF EOF(2) OR _
  106.          (ZSubParm = -1 AND NOT ZLocalUser) THEN _
  107.          GOTO 20142
  108. 20126 CALL ReadDir (2,1)
  109.       IF ZErrCode <> 0 THEN _
  110.          ZWasEL = 20126 : _
  111.          GOTO 21900
  112.       IF WasCK = 0 THEN _
  113.          GOTO 20140
  114.       IF LEFT$(ZOutTxt$,1) = " " THEN _
  115.          IF LastOK AND NOT ZExtendedOff THEN _
  116.             GOTO 20140 _
  117.          ELSE GOTO 20124
  118.       LastOK = ZFalse
  119. 20128 IF ZJumpSearching THEN _
  120.          GOTO 20129
  121.       IF WasCK < 2 THEN _
  122.          GOTO 20130
  123.       IF WildSearch THEN _
  124.          ZWasA = INSTR(ZOutTxt$," ") : _
  125.          IF ZWasA = 0 THEN _
  126.             GOTO 20124 _
  127.          ELSE ZWasZ$ = LEFT$(ZOutTxt$,ZWasA - 1) : _
  128.               CALL WildFile (WasRS$,ZWasZ$,WasXXX) : _
  129.               WasXXX = NOT WasXXX : _
  130.               GOTO 20136
  131. 20129 ZWasZ$ = ZOutTxt$
  132.       CALL AllCaps (ZWasZ$)
  133.       WasXXX = (INSTR(ZWasZ$,WasRS$) = 0)
  134.       GOTO 20136
  135. 20130 ZWasA = INSTR(9,MID$(ZOutTxt$,1,32),"/")
  136.       IF ZWasA = 0 THEN _
  137.          ZWasA = INSTR(9,MID$(ZOutTxt$,1,32),"-")
  138. 20132 IF ZWasA < 3 THEN _
  139.          GOTO 20124
  140.       IF INSTR("0123456789",MID$(ZOutTxt$,ZWasA - 1,1)) = 0 THEN _
  141.          GOTO 20124
  142.       ZWasA = ZWasA - 2
  143.       WasWK$ = RIGHT$(MID$(ZOutTxt$,ZWasA,8),2) + _
  144.             LEFT$(MID$(ZOutTxt$,ZWasA,8),2) + _
  145.             MID$(MID$(ZOutTxt$,ZWasA,8),4,2)
  146.       IF MID$(WasWK$,3,1) = " " THEN _
  147.          MID$(WasWK$,3,1) = "0"
  148.       IF MID$(WasWK$,5,1) = " " THEN _
  149.          MID$(WasWK$,5,1) = "0"
  150. 20134 WasXXX = (WasWK$ < WasRS$)
  151. 20136 IF WasXXX THEN _
  152.          GOTO 20124
  153.       IF ZJumpSearching THEN _
  154.          WasRS$ = PrevSearch$ : _
  155.          WasCK = PrevCK : _
  156.          ZJumpSearching = ZFalse : _
  157.          GOTO 20140
  158.       IF WasPG THEN _
  159.          WasPG = ZFalse : _
  160.          CALL OpenWork (2,ZFileName$) : _
  161.          ZWasQ = 0 : _
  162.          GOTO 20124
  163. 20138 IF WasPG THEN _
  164.          GOTO 20124
  165. 20140 LastOK = ZTrue
  166.       GOSUB 21650
  167.       IF ZFileSysParm > 1 THEN _
  168.          RETURN
  169.       CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
  170.       IF ZNo THEN _
  171.          ZErrCode = 0 : _
  172.          RETURN
  173.       IF ZJumpSearching THEN _
  174.          IF LEFT$(ZOutTxt$,1) <> " " THEN _
  175.             PrevSearch$ = WasRS$ : _
  176.             PrevCK = WasCK : _
  177.             WasCK = 2 : _
  178.             WasRS$ = ZJumpTo$
  179.       IF NOT ZRet THEN _
  180.          GOTO 20124
  181. 20142 ZWasQ = 0
  182.       ZJumpSupported = ZFalse
  183.       CLOSE 2
  184.       CALL Carrier
  185.       IF ZSubParm = -1 THEN _
  186.          ZFileSysParm = 7
  187.       RETURN
  188. '
  189. ' *  L - COMMAND FROM FILES MENU (LIST DIRECTORY)
  190. '
  191. 20150 ZListDir = ZTrue
  192.       ListNew = ZFalse
  193.       SearchDate$ = ""
  194.       SearchString$ = ""
  195.       WasRS$ = ""
  196.       ShowDirOfDir = (ZLastIndex <= ZAnsIndex) AND NOT ZExpertUser
  197.       WasCK = 0
  198.       ZSearchingAll = ZFalse
  199. 20155 IF ZDnldCompleted AND ZAutoEnd = 1 THEN _   'Pe 02/05/90
  200.         ZFileSysParm = 7: _
  201.         RETURN
  202. '  IF ListNew OR ZAnsIndex > 255 THEN _
  203. '         RETURN
  204.   IF ZAnsIndex > 255 THEN _    'Pe 03/18/90
  205.          RETURN
  206.       CALL GetDirs   (ShowDirOfDir)  'Pe 02/04/90     ' Bh 06/25/90
  207.       IF ZWasQ = 0 THEN _
  208.          RETURN
  209.       ShowDirOfDir = ZFalse
  210.       CALL ConvertDir (ZAnsIndex)
  211.       WasQX = ZLastIndex
  212. 20157 CALL Carrier
  213.       IF ZSubParm = -1 THEN _
  214.          ZFileSysParm = 7 : _
  215.          RETURN
  216.       GOTO 20161
  217. 20159 IF ZAnsIndex < ZLastIndex THEN _
  218.          GOTO 20155
  219.       ZSearchingAll = ZFalse
  220.       CALL CmdStackPushPop (1)
  221.       ZLastIndex = 0
  222.       IF ZNo OR (ZFileNameHold$ = ZDirPrefix$) THEN _
  223.          GOTO 20155
  224.   CALL QuickTPut (ZEmphasizeOff$,0)
  225.   ZOutTxt$ = "__________________________________________________" + ZCrLf$     ' Bh 083090
  226.   ZOutTxt$ = ZOutTxt$ + "That's all!  R)elist,+)xtra,V)iew,[Q]uit, or file(s) to download"   'Pe 02/15/90
  227.       ZStackC = ZTrue
  228.       GOSUB 21668
  229.       CALL AllCaps (ZUserIn$(1))
  230. '******************************* Pe 02/15/90 **********************
  231.      IF ZUserIn$(1) = "+"  AND _
  232.          ZUserSecLevel >= ZOptSec(19 - 20 * (ZMenuIndex = 6)) THEN _
  233.          ZAnsIndex = 1 : _   
  234.         CALL TypeFile : _
  235.        RETURN
  236.      IF ZUserIn$(1) = "V"  AND _
  237.          ZUserSecLevel >= ZOptSec(19 - 20 * (ZMenuIndex = 6)) THEN _
  238.          ZAnsIndex = 1 : _   
  239.         CALL GetArc : _
  240.        RETURN
  241. '******************************************************************
  242.       IF ZUserIn$(1) = "R" THEN _
  243.          ZUserIn$(ZAnsIndex) = WasA1$ : _
  244.          GOTO 20161
  245.       IF LEN(ZUserIn$(1)) > 1 AND _
  246.          ZUserSecLevel >= ZOptSec(19 - 20 * (ZMenuIndex = 6)) THEN _
  247.          ZAnsIndex = 1 : _
  248.          GOSUB 20202
  249.       CALL CmdStackPushPop (2)
  250.       RETURN
  251. 20161 IF INSTR(ZUserIn$(ZAnsIndex),".") THEN _
  252.          GOTO 20172
  253.       ZViolation$ = "List Dir. "
  254.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  255.       ZWasA = INSTR("E+E-E",ZWasZ$)
  256.       IF ZWasA > 0 THEN _
  257.          IF ZWasA = 5 THEN _
  258.             ZExtendedOff = NOT ZExtendedOff : _
  259.             GOTO 20155 _
  260.          ELSE ZExtendedOff = (ZWasA > 2) : _
  261.               GOTO 20155
  262.       CALL AllCaps(ZWasZ$)
  263.       ZFileNameHold$ = ZWasZ$
  264.       WasA1$ = ZWasZ$
  265.       IF ZWasZ$ = ZDirPrefix$ THEN _
  266.          GOTO 20164
  267.       InFMS = ZFalse
  268. 20162 CALL CmdStackPushPop (1)         ' save dir list list processing
  269.       CALL FMS (ZWasZ$,SearchString$,SearchDate$,InFMS, _
  270.                 ZCategoryName$(),ZCategoryCode$(),ZCategoryDesc$(),_
  271.                 DnldFlag,CatFound,ZAnsIndex)
  272.       WHILE DnldFlag > 0 AND ZSubParm > -1
  273.          GOSUB 20202
  274.          IF ZFileSysParm > 1 THEN _
  275.             RETURN
  276.         IF ZDnldCompleted and ZAutoEnd = 1 THEN _  'Pe 02/05/90
  277.            RETURN       ' AUTOLOGOFF MOD
  278.          WasX$ = ZCategoryCode$(CatFound)
  279.          CALL DispUpDir (WasX$,SearchString$,SearchDate$,DnldFlag,ZAnsIndex)
  280.          CALL CheckTimeRemain (MinsRemaining)
  281.          IF ZSubParm = -1 THEN _
  282.             ZFileSysParm = 6 : _
  283.             RETURN
  284.          CALL Carrier
  285.       WEND
  286.       IF ZSubParm = -1 THEN _
  287.          ZFileSysParm = 7 : _
  288.          RETURN
  289.       IF ZAnsIndex > 255 THEN _
  290.          ZLastIndex = 0 : _
  291.          RETURN
  292.       CALL CmdStackPushPop (2)        ' restore dir list list processing
  293.       ZActiveFMSDir$ = ""
  294.       IF InFMS THEN _
  295.          GOTO 20159
  296.       IF ZUserSecLevel < ZMinSecToView THEN _
  297.          IF ZFileNameHold$ = ZUpldDirCheck$ THEN _
  298.         ZOutTxt$ = "Listing of Upload Directory Available to SYSOP Only" : _ 'DGS-TXT
  299.         GOSUB 21640 : _                                           'DGS-TXT
  300.         ZNo = ZTrue : _                                           'DGS-TXT
  301.         GOTO 20155                                                'DGS-TXT
  302. '            ZFileNameHold$ = "of uploads" : _
  303. '            GOTO 20172
  304.       ZFileNameHold$ = ZUserIn$(ZAnsIndex)
  305.       IF ZLimitSearchToFMS THEN _
  306.          GOTO 20166
  307.       IF NOT ZSearchingAll THEN _
  308.          IF ZFileNameHold$ = "ALL" OR ZFileNameHold$ = "A" THEN _
  309.             ZSearchingAll = ZTrue : _
  310.             GOSUB 21890 : _
  311.             GOTO 20157
  312.       CALL BadFile (ZFileNameHold$,BadFileNameIndex)
  313.       ON BadFileNameIndex GOTO 20163,20172,20176
  314. 20163 ZFileName$ = ZFileNameHold$
  315.       CALL BadName (BadFileNameIndex)
  316.       ON BadFileNameIndex GOTO 20164,20176
  317. 20164 IF ZFileName$ = ZUpldDirCheck$ AND _
  318.          ZUserSecLevel >= ZMinSecToView THEN _
  319.             ZFileName$ = ZUpldPath$ _
  320.       ELSE ZFileName$ = ZCurDirPath$
  321.       ZFileName$ = ZFileName$ + _
  322.                    ZFileNameHold$ + _
  323.                    "." + _
  324.                    ZDirExtension$
  325.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  326. 20165 IF ZOK THEN _
  327.          CALL ReadDir (2,1) : _
  328.          IF ZErrCode = 0 THEN _
  329.             IF LEFT$(ZOutTxt$,4) = "\FMS" THEN _
  330.                InFMS = ZTrue : _
  331.                ZActiveFMSDir$ = ZFileName$ : _
  332.                GOTO 20162 _
  333.             ELSE GOTO 20167
  334. 20166 ZFileName$ = ZCurDirPath$ + _
  335.                    ZFileNameHold$ + ".MNU"
  336.       CALL FindIt (ZFileName$)
  337.       IF ZOK THEN _
  338.          CALL BufFile (ZFileName$,ZAnsIndex) : _
  339.          GOTO 20155
  340.       IF ZAltdirExtension$ = "" THEN _
  341.          GOTO 20172
  342.       ZFileName$ = ZCurDirPath$ + _
  343.                    ZFileNameHold$ + _
  344.                    "." + _
  345.                    ZAltdirExtension$
  346.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  347.       IF NOT ZOK THEN _
  348.          GOTO 20172
  349. 20167 ZUserIn$(0) = ZUserIn$(ZAnsIndex)
  350.       GOSUB 20120
  351.       IF ZFileSysParm > 1 THEN _
  352.          RETURN
  353.       GOTO 20170
  354. 20168 CALL BufFile(ZFileName$,ZAnsIndex)
  355.       CALL Carrier
  356.       IF ZSubParm = -1 THEN _
  357.          ZFileSysParm = 7 : _
  358.          RETURN
  359. 20170 IF ZAnsIndex > 255 THEN _
  360.          ZLastIndex = 0 : _
  361.          RETURN
  362.       ZUserIn$(ZAnsIndex) = ZUserIn$(0)
  363.       GOTO 20159
  364. 20172 IF NOT ZSearchingAll THEN _
  365.          ZOutTxt$ = "Directory " + _
  366.               ZFileNameHold$ + _
  367.               " not found!" : _
  368.          GOSUB 21640 : _
  369.          ZNo = ZTrue : _
  370.          IF ZFileSysParm > 1 THEN _
  371.             RETURN
  372.       GOTO 20155
  373. 20176 CALL SecViolation
  374.       IF ZDenyAccess THEN _
  375.          ZFileSysParm = 4 : _
  376.          RETURN
  377.       GOTO 20172
  378. '
  379. ' *  D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD)
  380. '
  381. 20180 ZOutTxt$ = "Default Extension is " +ZDefaultExtension$ + ZCrLf$ + _
  382.                  "Download what file(s)"
  383.       ZStackC = ZTrue
  384.       GOSUB 21668
  385.       IF ZFileSysParm > 1 THEN _
  386.          RETURN
  387.       IF ZWasQ = 0 THEN _
  388.          RETURN
  389. 20202 IF (ZTimeLock AND 2) AND (NOT TimeLockExempt) AND NOT ZHasPrivDoor THEN _
  390.          CALL TimeLock : _
  391.          IF NOT ZOK THEN _
  392.             RETURN
  393.       LastDnld = ZLastIndex
  394.       FirstDnld = ZAnsIndex
  395.       ZCmdTransfer$ = ""
  396. '      IF ZAutoDownYes THEN _   'Pe 02/04/90
  397. '        ZCmdTransfer$ = "X"
  398. '      ZAutoDownInProgress = ZAutoDownYes
  399.       ZAnsIndex = ZLastIndex
  400.       GOSUB 20470
  401.       LastDnld = LastDnld + (WasX > 0)
  402.       BatchBytes# = 0
  403.       BatchBlocks# = 0
  404.       ZDownFiles = 0
  405.       CALL KillWork (ZNodeWorkFile$)
  406.       ZErrCode = 0
  407.       FOR ZAnsIndex = FirstDnld TO LastDnld
  408.          GOSUB 20470
  409.          GOSUB 20205
  410.          ZCmdTransfer$ = ZWasFT$
  411.          CALL Line25
  412.          IF ZFileSysParm > 1 OR ZInternalProt$ = "N" THEN _
  413.             ZAnsIndex = LastDnld + 1
  414. 20203 NEXT
  415.       ZLastIndex = 0
  416.       IF ZFileSysParm > 1 THEN _
  417.          RETURN
  418.       ZBatchTransfer = ZFalse
  419.       ZCmdTransfer$ = ""
  420.       RETURN
  421. 20205 MarkingTime = (ZAnsIndex = FirstDnld OR NOT ZConcatFIles)
  422.       ZFileName$ = ZUserIn$(ZAnsIndex)
  423. '      CALL AllCaps(ZFileName$)              'ANSIEd    ' Bh 110790
  424.       CALL Remove (ZFileName$,", ")
  425.       ZViolation$ = "Download "
  426.       IF PersonalDnld THEN _
  427.          CALL BreakFileName (ZFileName$,DR$,ZWasY$,WasX$,ZTrue) : _
  428.          ZFileNameHold$ = ZWasY$ + _
  429.                            WasX$ : _
  430.          GOTO 20235
  431.       ZFileNameHold$ = ZFileName$
  432.       CALL BadFile (ZFileName$,BadFileNameIndex)
  433.       ON BadFileNameIndex GOTO 20220,20231,20233
  434. 20220 FileNameAlt$ = ""                         ' Pe 02/16/90
  435.       IF INSTR (ZFileName$,".") = 0 THEN _
  436.          FileNameAlt$ = ZFileName$ : _
  437.          ZFileName$ = ZFileName$ + "." + ZDefaultExtension$ : _
  438.        ZFileNameHold$ = ZFileNameHold$ + "." + ZDefaultExtension$ ' Pe 02/16/90
  439. 20222 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + _
  440.                       ((ZUserSecLevel < ZMinSecToView) OR _
  441.                        NOT ZCanDnldFromUp),MarkingTime,"D")
  442. 20225 IF ZOK THEN _
  443.          GOTO 20235
  444.       IF ZDotFlag THEN _
  445.          RETURN
  446.       IF FileNameAlt$ <> "" THEN _
  447.          ZFileName$ = FileNameAlt$ : _
  448.          FileNameAlt$ = "" : _
  449.          ZFileNameHold$ = ZFileName$ : _
  450.          GOTO 20222
  451. 20231 ZNotHere$ = ZWelcomeFileDrvPath$ + "NOTHERE.DEF"   ' Bh 090990
  452. '      ZBobNo$ = "Hmmm....I can't seem to find " + ZFileNameHold$ + _
  453. '           ". I don't think I have it."     ' Bh
  454.       CALL BufFile (ZNotHere$,WasX)
  455.       IF NOT ZOK THEN _
  456.       ZBobNo$ = "Hmmm...I can't seem to find " + ZFileNameHold$ + _
  457.            ". You sure it's in this collection?" + ZCrLf$  ' Bh
  458.       ZOutTxt$ = ZBobNo$ + "Try typing it again "+ZPressEnterExpert$
  459. '      CALL QuickTPut1 (ZBobNo$ + ZCrLf$ + "Try again "+ZPressEnterExpert$)
  460.       CALL UpdtCalr ("Couldn't find " + ZFileNameHold$,1)
  461.       'IF ZAutoDownInProgress THEN _                                  ' DA090903
  462.       '   ZOutTxt$ = ZOutTxt$ + _
  463.       '        " during AUTODOWNLOAD" : _
  464.       '   GOSUB 21640 : _
  465.       '   RETURN
  466.       'ZOutTxt$ = ZOutTxt$ + ZCrLf$ + _
  467.       '    "You are either in a BY REQUEST ONLY collection, or " + ZCrLf$    ' Bh 090690
  468.       'ZOutTxt$ = ZOutTxt$ + _
  469.       '     "Perhaps you misspelled.  Try again "+ZPressEnterExpert$   ' Bh 090690
  470.       ZSuspendAutoLogoff = ZTrue                                     ' KG112202
  471.       GOSUB 21660
  472.       ZSuspendAutoLogoff = ZFalse
  473.       IF ZFileSysParm > 1 THEN _
  474.          RETURN
  475.       IF ZWasQ=0 THEN _
  476.          IF ZBatchTransfer AND ZAnsIndex >= LastDnld THEN _
  477.             GOTO 20262 _
  478.          ELSE ZAutoLogOffReq = ZFalse : _
  479.               RETURN
  480.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  481.       GOTO 20205
  482. 20233 CALL SecViolation
  483.       IF ZDenyAccess THEN _
  484.          ZFileSysParm = 4 : _
  485.          RETURN
  486.       GOTO 20231
  487. 20235 CALL BadName (BadFileNameIndex)
  488.       ON BadFileNameIndex GOTO  20236,20245
  489. 20236 ZLine25$ = "(D) " + _
  490.                  ZWasZ$
  491. '      IF ZAutoDownInProgress THEN _
  492. '         MID$(ZLine25$,2,1) = "A"
  493. '
  494. ' *  TEST FOR DOWNLOAD SECURITY
  495. '
  496.       CALL OpenWork (2,ZFileSecFile$)
  497.       IF ZErrCode = 53 THEN _
  498.          CALL UpdtCalr ("Missing file " + ZFileSecFile$,2) : _
  499.          GOTO 20247
  500. 20242 IF EOF(2) THEN _
  501.          GOTO 20247
  502.       CALL ReadParms (ZWorkAra$(),3,1)
  503.       IF ZErrCode <> 0 THEN _
  504.          ZWasEL = 20242 : _
  505.          GOTO 21900
  506. 20243 CALL WildFile (ZWorkAra$(1),ZWasZ$,ZOK)
  507.       IF NOT ZOK THEN _
  508.          GOTO 20242
  509. 20244 IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _
  510.          GOTO 20245
  511.       FilePswd$ = ZWorkAra$(3)
  512.       IF FilePswd$ = "" THEN _
  513.          GOTO 20247
  514.       CALL AllCaps (FilePswd$)
  515.       IF FilePswd$ = ZPswd$ THEN _
  516.          GOTO 20247
  517.       ZOutTxt$ = "Enter PASSWORD to download " + _
  518.            ZFileName$
  519.       GOSUB 21660
  520.       IF ZFileSysParm > 1 THEN _
  521.          RETURN
  522.       IF ZWasQ = 0 THEN _
  523.          RETURN
  524.       CALL AllCaps (ZUserIn$(1))
  525.       IF ZUserIn$(1) = FilePswd$ THEN _
  526.          GOTO 20247
  527. 20245 ZViolation$ = "DownLoad " + _
  528.                    ZFileName$
  529. 20246 CALL SecViolation
  530.       IF ZDenyAccess THEN _
  531.          ZFileSysParm = 4
  532.       RETURN
  533. 20247 ZWasDF = 0
  534.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZFalse)
  535.       'IF ZAutoDownInProgress THEN _
  536.       '   ZOutTxt$ = "Transferring -- " + _
  537.       '        ZUserIn$(ZAnsIndex) : _
  538.       '   GOSUB 21640 : _
  539.       '   IF ZFileSysParm > 1 THEN _
  540.       '      RETURN
  541.       IF INSTR("...WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR.ZIP.PAK.ZOO.LZH.","."+Extension$+".") > 2 OR _
  542.          MID$(Extension$,2,1) = "Q" OR _
  543.          (ZRequireNonASCII AND Extension$ = "BAS") THEN _
  544.             ZWasDF = ZTrue
  545. 20248 ZOutTxt$ = ""
  546.       IF ZBatchTransfer THEN _
  547.          IF ZAnsIndex < LastDnld THEN _
  548.             GOTO 20260
  549.       CALL XferType (2,ZTrue)
  550.       IF ZFF THEN _
  551.          GOTO 20260
  552.       CALL XferType (1,ZTrue)
  553.       IF ZSubParm = -1 THEN _
  554.          ZFileSysParm = 7 : _
  555.          RETURN
  556. 20260 ZTransferFunction = 1
  557.       GOSUB 21790
  558.       IF ZFileSysParm > 1 THEN _
  559.          RETURN
  560.       ZBatchTransfer = ZBatchProto                     'Pe Batch Mod
  561.       IF ZBatchTransfer AND ZCmdTransfer$ = "" THEN _
  562.          ZCmdTransfer$ = ZWasFT$
  563.       ON INSTR("AXCYN",ZInternalProt$) GOTO _
  564.          20340, _              ' ASCII DOWNLOAD
  565.          20290, _              ' Xmodem
  566.          20290, _              ' Xmodem CRC
  567.          20270, _              ' YMODEM
  568.          21700                 ' NONE - CANCEL
  569. '
  570. ' *  EXTERNAL Protocol Downloads/Uploads
  571. '
  572. 20261 IF ZReq8Bit THEN _
  573.          IF NOT ZEightBit THEN _
  574.             GOSUB 20318 : _
  575.             IF ZFileSysParm > 1 THEN _
  576.                RETURN _
  577.             ELSE GOSUB 20992 : _
  578.                  IF ZFileSysParm > 1 THEN _
  579.                     RETURN
  580.       IF ZTransferFunction = 1 THEN _
  581.          GOSUB 20750 : _
  582.          CLOSE 2 : _
  583.          IF ZFileSysParm > 1 OR NOT ZOK THEN _
  584.             RETURN
  585. 20262 IF ZBatchTransfer THEN _
  586.          IF ZAnsIndex < LastDnld THEN _
  587.             RETURN _
  588.          ELSE ZBlocksInFile# = BatchBlocks# : _
  589.               ZBytesInFile# = BatchBytes# : _
  590.               ZNumDnldBytes! = BatchBytes# : _
  591.               IF ZBytesInFile# < 1 THEN _
  592.                  RETURN _
  593.               ELSE GOSUB 20780 : _
  594.                    IF ZFileSysParm > 1 OR NOT ZOK THEN _
  595.                       RETURN
  596. '      IF ZAutoDownInProgress THEN _
  597. '         CALL SendName                   'PE 02/16/90
  598.          IF ZAbort THEN _
  599.            ZDnldCompleted = ZFalse : _    'Pe 02/16/90
  600.             GOSUB 21760 : _
  601.             RETURN
  602.       CALL Transfer
  603. 20263 IF ZPrivateDoor THEN _
  604.          ZCmdTransfer$ = ZWasFT$ : _
  605.          CALL XferType (2,ZTrue) : _
  606.          ZCmdTransfer$ = ""
  607.       CALL OpenWork (2,"XFER-" + ZNodeID$ + ".DEF")
  608.       IF ZErrCode <> 0 THEN _
  609.          GOTO 20267
  610.       CALL ReadParms (ZWorkAra$(), ZFailureParm, 1)
  611.       IF ZErrCode <> 0 THEN _
  612.          GOTO 20267
  613.       CALL KillWork ("XFER-" + ZNodeID$ + ".DEF")
  614. 20264 IF ZPrivateDoor THEN _
  615.          ZFileName$ = ZWorkAra$(1) : _
  616.          CALL BreakFileName (ZFileName$,WasX$,ZFileNameHold$,ZWasY$,ZTrue) : _
  617.          ZFileNameHold$ = ZFileNameHold$ + _
  618.                            ZWasY$
  619.       IF LEFT$(ZWorkAra$(ZFailureParm),1) = "L" THEN _
  620.          MID$(ZWorkAra$(ZFailureParm),1,1) = ZFailureString$
  621. 20265 IF ZTransferFunction = 2 THEN _
  622.          IF INSTR(ZWorkAra$(ZFailureParm),ZFailureString$) <> 1 THEN _
  623.             GOTO 20700 _
  624.          ELSE GOTO 20730
  625.       IF ZTransferFunction = 1 THEN _
  626.   ZDnldCompleted = (INSTR(ZWorkAra$(ZFailureParm),ZFailureString$) <> 1) 'Pe 02/05/90
  627.       GOSUB 21760
  628.       CALL Carrier
  629.       IF ZSubParm = -1 THEN _
  630.          ZFileSysParm = 7
  631.       RETURN
  632. '
  633. ' *  XFER FILE NOT Found
  634. '
  635. 20267 ZWasEL = 20263
  636.       GOTO 21900
  637.  
  638. '
  639. ' *  YMODEM DOWNLOAD DRIVER
  640. '
  641. 20270 GOTO 20292
  642. '
  643. ' *  Xmodem DOWNLOAD DRIVER
  644. '
  645. 20290 '
  646. 20292 GOSUB 20750
  647.       IF ZFileSysParm > 1 OR NOT ZOK THEN _
  648.          RETURN
  649.       WasA1$ = "SEND"
  650.       GOSUB 20320
  651.       IF ZFileSysParm > 1 THEN _
  652.          RETURN
  653.       IF ZLocalUser THEN _
  654.          CALL QuickTPut1 ("Protocol not available in local mode") : _
  655.          RETURN
  656. '      IF ZAutoDownInProgress THEN _
  657. '         GOSUB 20294                    'PE 02/16/90
  658.          IF ZAbort THEN _               'PE 02/16/90
  659.             RETURN
  660.       GOSUB 21300
  661.       IF ZFileSysParm > 1 THEN _
  662.          RETURN
  663.       ZOutTxt$ = ""
  664.       GOTO 20390
  665. '20294 CALL SendName
  666. '      RETURN
  667. 20318 ZOutTxt$ = "Please Switch to N,8,1 for binary transfer"
  668.       GOSUB 21630
  669.       IF ZFileSysParm > 1 THEN _
  670.          RETURN
  671.       CALL DelayTime (3)
  672.       RETURN
  673. 20320 IF NOT ZEightBit THEN _
  674.          GOSUB 20318 : _
  675.          IF ZFileSysParm > 1 THEN _
  676.             RETURN
  677. 20325 IF ZCheckSum THEN _
  678.          ZNAK$ = CHR$(21) : _
  679.          SOL = 132 _
  680.       ELSE ZNAK$ = "C" : _
  681.            SOL = 133
  682. 20330 'IF ZAutoDownInProgress THEN _
  683.       '   RETURN
  684.       ZOutTxt$ = ZProtoPrompt$ + _
  685.             " " + WasA1$ + _
  686.             " of " + _
  687.             ZFileNameHold$ + _
  688.             " ready.  <Ctrl X> aborts"
  689.       GOSUB 21650
  690.       'IF WasA1$ = "SEND" THEN _
  691.       '   CALL Talk (8,ZOutTxt$) _
  692.       'ELSE CALL Talk (9,ZOutTxt$)
  693.       RETURN
  694. '
  695. ' *  ASCII DOWNLOAD DRIVER
  696. '
  697. 20340 IF ZWasDF THEN _
  698.          ZOutTxt$ = "Switch to a non-ascii protocol" : _
  699.          GOSUB 21650 : _
  700.          GOTO 21700
  701.       GOSUB 20750
  702.       IF ZFileSysParm > 1 OR NOT ZOK THEN _
  703.          RETURN
  704.       CALL OpenWork (2,ZFileName$)
  705.       IF (ZAnsIndex = FirstDnld OR NOT ZConcatFIles) THEN _
  706.          ZOutTxt$ = "^X aborts.  ^S suspends ^Q resumes" : _
  707.          GOSUB 21640 : _
  708.          IF ZFileSysParm > 1 THEN _
  709.             RETURN _
  710.          ELSE ZOutTxt$ = ZProtoPrompt$ + " SEND of " + _
  711.               ZFileNameHold$ + _
  712.               " ready. Press Any Key to start" : _
  713.          ZTurboKey = 2 : _
  714.          ZForceKeyboard = ZTrue : _
  715.          ZSuspendAutologoff = ZTrue : _
  716.          GOSUB 21660 : _
  717.          ZSuspendAutologoff = ZFalse : _
  718.          IF ZFileSysParm > 1 THEN _
  719.             RETURN
  720. 20380 ZStopInterrupts = ZFalse
  721.       WasTU = 0
  722.       SWAP WasTU,ZPageLength
  723.       CALL BufFile (ZFileName$,WasX)
  724.       SWAP WasTU,ZPageLength
  725.       ZNonStop = (ZPageLength < 1)
  726.       IF StopFile THEN _
  727.          ZDnldCompleted = ZFalse : _  'Pe 02/05/90
  728.          GOTO 20390
  729. 20381 IF (ZAnsIndex = LastDnld OR NOT ZConcatFIles) THEN _
  730.          CALL QuickTPut (CHR$(26),0) : _
  731.          IF NOT ZLocalUser AND ZSubParm = 0 THEN _
  732.             FOR WasX = 1 TO 5 : _
  733.                CALL PutCom (CHR$(7)) : _
  734.                CALL DelayTime (3) : _
  735.             NEXT
  736. 20385 ZDnldCompleted = ZTrue   'Pe 02/05/90
  737. 20390 GOTO 21760
  738. '
  739. ' *  U - COMMAND FROM FILES MENU (UPLOAD)
  740. '
  741. 20395 GOSUB 21640
  742.       IF ZFileSysParm > 1 THEN _
  743.          RETURN
  744.       ZOutTxt$ = "Correct name of file to upload" + _
  745.            ZPressEnterExpert$
  746.       GOSUB 21660
  747.       IF ZFileSysParm > 1 THEN _
  748.          RETURN
  749.       IF ZWasQ = 0 THEN _
  750.          RETURN
  751.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  752.       GOTO 20435
  753. 20400 CALL TimeBack (1)
  754.       GOSUB 20420
  755.       ZAutoLogOffReq = 0
  756.       FirstUpld = ZAnsIndex
  757.       GOTO 20430
  758. 20420 ZOutTxt$ = "Upload what file(s)"
  759.       ZStackC = ZTrue
  760.       GOSUB 21668
  761.       RETURN
  762. '
  763. ' *  SEARCH FOR DUPLICATE FILENAME
  764. '
  765. 20430 ZAnsIndex = ZLastIndex
  766.       GOSUB 20470
  767.       ZLastIndex = ZLastIndex + (WasX > 0)
  768.       FOR ZAnsIndex = FirstUpld TO ZLastIndex
  769.          GOSUB 20470
  770.          GOSUB 20435
  771.          IF ZFileSysParm > 1 THEN _
  772.             ZAnsIndex = ZLastIndex + 1
  773.       NEXT
  774.       ZCmdTransfer$ = ""
  775.       RETURN
  776. 20435 ZFileNameHold$ = ZUserIn$(ZAnsIndex)
  777.       IF INSTR(ZFileNameHold$,".") = 0 THEN _
  778.          ZFileNameHold$ = ZFileNameHold$ + "." + ZDefaultExtension$
  779.       CALL AllCaps(ZFileNameHold$)
  780.       ZFileName$ = ZFileNameHold$
  781.       ZViolation$ = "Upload "
  782.       CALL NoPath (ZFileName$,BadFileNameIndex)
  783.       IF BadFileNameIndex THEN _
  784.          GOTO 20451
  785.       CALL BadFile (ZFileName$,BadFileNameIndex)
  786.       ON BadFileNameIndex GOTO 20440,20451,20515
  787. 20440 TmpName$ ="NOTHANX.DEF"                                       'PE mode to
  788.       CALL FindIt (TmpName$)                                        'DGS-UNW
  789.       IF ZOK THEN
  790.        CALL QuickTPut ("Checking off line file list....",1)
  791. CALL OpenWork (2,TmpName$)
  792.     HaveFile$ = ""
  793.      FileInList = ZFalse
  794.       WHILE NOT EOF(2) AND NOT FileInList
  795.         INPUT #2, HaveFile$
  796.         CALL AllCaps (HaveFile$)
  797.         FileInList = (INSTR(ZFileNameHold$,HaveFile$) > 0)
  798.      WEND
  799.      CLOSE 2
  800.       END IF
  801.       IF FileInList THEN _
  802.       CALL BufFile ("NOTHANX.MSG",WasX) : _
  803.       CALL DelayTime (3) : _
  804.      GOTO 20453
  805.       CALL Carrier
  806.       IF ZSubParm = -1 THEN _
  807.          ZFileSysParm = 7 : _
  808.       RETURN
  809.      CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount,ZTrue,"U")
  810. 20445 IF ZOK THEN _
  811.          GOTO 20452
  812.       IF INSTR(ZFileName$,".") = 0 THEN _
  813.          GOTO 20475
  814.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZFalse)
  815.       WasI = 1
  816. 20447 WasJ = INSTR(MID$(ZCompressedExt$+". ",WasI),".")
  817.       IF WasJ = 0 THEN _
  818.          GOTO 20475
  819.       Check$ = MID$(ZCompressedExt$,WasI,WasJ-1)
  820.       WasI = WasI + WasJ
  821. 20450 IF Extension$ <> Check$ THEN _
  822.    CALL RotorsDir (WasX$ + "." + Check$,ZSubDir$(),ZSubDirCount,ZTrue,"U") : _
  823.          IF ZOK THEN _
  824.             GOTO 20452
  825.       GOTO 20447
  826. 20451 ZOutTxt$ ="Invalid file name. File name cannot contain a Drive letter"+ _ 'Pe 02/04/90
  827.        ZCrLf$ + "Subdirectory name, a Space, or any WildCard Characters "
  828.       GOSUB 21655
  829.       CALL DelayTime (2)
  830.       ZFileSysParm = 3
  831.       RETURN              'Pe 02/04/90
  832. 20452 IF ZUserSecLevel < ZOverWriteSecLevel THEN _
  833.          GOTO 20453
  834.       ZOutTxt$ = "Overwrite file (Y,[N])"
  835.       GOSUB 21660
  836.       IF ZFileSysParm > 1 THEN _
  837.          RETURN
  838.       IF NOT ZYes THEN _
  839.          GOTO 20453
  840.       ZWasZ$ = ZFileName$
  841.       CALL KillWork (ZFileName$)
  842.       IF ZErrCode <> 0 THEN _
  843.          ZWasEL = 20452 : _
  844.          GOTO 21900
  845.       GOTO 20475
  846. 20453 CLOSE 2
  847.       IF ZUserSecLevel >= ZAddDirSecurity THEN _
  848.          GOTO 20455
  849. 20454 CALL QuickTPut1 ("Thanks, but we already have " + ZFileNameHold$)
  850.       CALL UpdtCalr ("Upload duplicate " + ZFileNameHold$,2)
  851.       RETURN
  852. 20455 ZOutTxt$ = "Add new directory entry (Y,[N])"
  853.       ZTurboKey = - ZTurboKeyUser
  854.       GOSUB 21660
  855.       IF ZFileSysParm > 1 THEN _
  856.          RETURN
  857.       IF NOT ZYes THEN _
  858.          RETURN
  859.       AddingDescOnly = ZTrue
  860.       ZWasFT$ = "l"
  861. CALL UpdtUpload (ZCategoryName$(),ZCategoryCode$(),ZLinesInMsg,1) 'UPL-MOD
  862.       GOSUB 20702
  863.       RETURN
  864. 20470 ' *** CHECK FOR Protocol IN FILE LIST ***
  865.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  866.       CALL AllCaps(ZWasZ$)
  867.       WasX = 0
  868.       IF LEN (ZWasZ$) = 1 THEN _
  869.          WasX = INSTR(ZDefaultXfer$,ZWasZ$) : _
  870.          IF WasX > 0 THEN _
  871.             ZAnsIndex = ZAnsIndex + 1 : _
  872.             ZCmdTransfer$ = ZWasZ$ : _
  873.             ZAutoDownInProgress = ZFalse : _
  874.             IF MID$(ZInternalEquiv$,WasX,1) = "N" THEN _
  875.                ZCmdTransfer$ = ""
  876.       RETURN
  877. 20475 ZWasZ$ = ZUpldDriveFile$
  878.       CALL FindFree
  879.       IF VAL(ZFreeSpace$) < 4096 THEN _
  880.          CALL QuickTPut1 ("No room for uploads.  Try tomorrow.") : _
  881.          ZAnsIndex = ZLastIndex + 1 : _
  882.          RETURN
  883.       ZOutTxt$ = "Upload disk has" + _
  884.            ZFreeSpace$
  885.       GOSUB 21640
  886.       IF ZFileSysParm > 1 THEN _
  887.          RETURN
  888. '*****************
  889. CALL UpdtUpload (ZCategoryName$(),ZCategoryCode$(),ZLinesInMsg,1)  '<++++++
  890. '*****************
  891. IF ZAbort THEN _     'PE 12/14/88
  892. ZAbort = ZFalse : _   'PE 12/14/88
  893.  RETURN
  894.       ZLine25$ = "(U) " + _
  895.                  ZFileNameHold$
  896.       ZSubParm = 2
  897.       CALL Line25
  898.       ZOutTxt$ = ""
  899.       ZOK = ZTrue
  900. 20477 CALL XferType (2,ZTrue)
  901.       IF ZFF THEN _
  902.          GOTO 20500
  903.       CALL XferType (1,ZTrue)
  904.       IF ZSubParm = -1 THEN _
  905.          ZFileSysParm = 7 : _
  906.          RETURN
  907. 20500 CALL AutoLogOff            'Pe 02/04/90
  908.       ZTransferFunction = 2
  909.       ZAutoDownInProgress = ZFalse
  910.       GOSUB 21790
  911.       IF ZFileSysParm > 1 THEN _
  912.          RETURN
  913.       ON INSTR("AXCYN",ZInternalProt$) GOTO _
  914.          20560, _         ' ASCII UPLOAD
  915.          20542, _         ' Xmodem
  916.          20542, _         ' Xmodem CRC
  917.          20542, _         ' YMODEM
  918.          20735            ' NONE - CANCEL
  919.       GOTO 20261
  920. 20510 WasD$ = "<Esc> by SYSOP aborts"
  921.       GOSUB 21710
  922.       RETURN
  923. 20515 CALL SecViolation
  924.       IF ZDenyAccess THEN _
  925.          ZFileSysParm = 4 : _
  926.          RETURN
  927.       GOTO 20420
  928. '
  929. ' *  Xmodem/YMODEM UPLOAD DRIVER
  930. '
  931. 20542 WasA1$ = "RECEIVE"
  932.       GOSUB 20320
  933.       IF ZFileSysParm > 1 THEN _
  934.          RETURN
  935.       ZOK = ZTrue
  936.       GOSUB 20860
  937.       IF ZFileSysParm > 1 THEN _
  938.          RETURN
  939.       IF ZOK THEN _
  940.          GOTO 20700
  941.       GOTO 20730
  942. '
  943. ' *  ASCII UPLOAD
  944. '
  945. 20560 LineACK = (ZDefaultLineACK$ <> "")
  946.       IF LineACK THEN _
  947.          ZOutTxt$ = "Acknowledge each line ([Y],N)" : _
  948.          ZTurboKey = - ZTurboKeyUser : _
  949.          LineACK = NOT ZNo : _
  950.          GOSUB 21660 : _
  951.          IF ZFileSysParm > 1 THEN _
  952.             RETURN
  953.       CALL QuickTPut1 ("Transfer MUST end with a <Ctrl-K>")
  954.       CALL QuickTPut1 (ZProtoPrompt$+" RECEIVE of " + ZFileNameHold$ + " ready")
  955.       ZOK = ZFalse
  956.       XOff = ZFalse
  957.       CALL OpenOutW(ZFileName$)
  958.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _
  959.          ZWasEL = 20560 : _
  960.          GOTO 21900
  961.       GOSUB 20510
  962.       IF ZFileSysParm > 1 THEN _
  963.          RETURN
  964. 20600 CALL EofComm (Char)
  965.       WHILE Char <> -1
  966.          CALL Carrier
  967.          IF ZSubParm = -1 THEN _
  968.             ZFileSysParm = 7 : _
  969.             RETURN
  970.          IF NOT ZFossil THEN _
  971.             IF LOF(3) < 512 THEN _
  972.                CALL PutCom(ZXOff$) : _
  973.                XOff = ZTrue
  974. 20610    CALL FlushCom (WasX$)
  975.          IF ZSubParm = -1 THEN _
  976.             ZFileSysParm = 7 : _
  977.             RETURN
  978.          IF INSTR(WasX$,CHR$(11)) THEN _
  979.             GOTO 20650
  980.          ZOK = ZTrue
  981. 20620    CALL PrintWork (WasX$)
  982.          IF LineACK THEN _
  983.             IF INSTR(WasX$,CHR$(10)) > 0 THEN _
  984.                CALL PutCom (ZDefaultLineACK$)
  985.          IF ZErrCode <> 0 THEN _
  986.             ZWasEL = 20620 : _
  987.             GOTO 21900
  988.          WasD$ = WasX$
  989.          NumReturns = 0
  990.          GOSUB 21720
  991.          IF ZFileSysParm > 1 THEN _
  992.             RETURN
  993. 20621    CALL FindFKey
  994.          IF ZSubParm < 0 THEN _
  995.             ZFileSysParm = 2 : _
  996.             RETURN
  997.          IF ZKeyPressed$ = ZEscape$ THEN _
  998.             GOTO 20745
  999.          IF NOT ZOK THEN _
  1000.             GOTO 20670
  1001.       CALL EofComm (Char)
  1002. 20630 WEND
  1003.       CALL Carrier
  1004.       IF ZSubParm = -1 THEN _
  1005.          ZFileSysParm = 7 : _
  1006.          RETURN
  1007.       IF XOff THEN _
  1008.          XOff = ZFalse : _
  1009.          CALL PutCom (ZXOn$) : _
  1010.          IF ZErrCode <> 0 THEN _
  1011.             ZWasEL = 20630 : _
  1012.             GOTO 21900
  1013.       GOTO 20600
  1014. 20650 WasX = INSTR(WasX$,CHR$(11))
  1015.       IF WasX = 1 THEN _
  1016.          IF NOT ZOK THEN _
  1017.             GOTO 20730 _
  1018.          ELSE GOTO 20700
  1019.       CALL PrintWorkA (LEFT$(WasX$,WasX-1))
  1020.       IF ZErrCode <> 0 THEN _
  1021.          ZWasEL = 20650 : _
  1022.          GOTO 21900
  1023.       GOTO 20700
  1024. 20670 ZOutTxt$ = ZXOff$ + _
  1025.            "System error! Upload aborted <Ctrl-K> continues"
  1026. 20675 GOSUB 21650
  1027.       IF ZFileSysParm > 1 THEN _
  1028.          RETURN
  1029.       CALL DelayTime (3)
  1030.       CALL PutCom(ZXOn$)
  1031. 20680 CALL EofComm (Char)
  1032.       WHILE Char <> -1
  1033.          CALL FlushCom(WasX$)
  1034.          IF INSTR(WasX$,CHR$(11)) THEN _
  1035.             GOTO 20730
  1036. 20685    CALL Carrier
  1037.          IF ZSubParm = -1 THEN _
  1038.             ZFileSysParm = 7 : _
  1039.             RETURN
  1040.       CALL EofComm (Char)
  1041.       WEND
  1042.       GOTO 20680
  1043. '
  1044. ' *  UPDATE UPLOAD DIRECTORY
  1045. '
  1046. 20700 GOSUB 21780
  1047.       IF ZFileSysParm > 1 THEN _
  1048.          RETURN
  1049. 20702 CALL UpdtUpload (ZCategoryName$(),ZCategoryCode$(), ZLinesInMsg,2) 'Pe 02/03/90
  1050.       IF ZAutoEnd = 1 THEN _                   'AUTO-UP MOD to next comment
  1051.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZTrue): _
  1052.       WasZ$ = WasX$+Extension$+ZWasDF$+" at "+ZTime$ + _
  1053.              " using " + ZWasFT$ + STR$(ZBytesInFile#) :_
  1054.       CALL UpdtCalr (WasZ$,2) : _
  1055.       RETURN                             'AUTO-UP MOD
  1056. '***** end of Auto Up Mod****
  1057.       ZPrivateDoor = ZFalse
  1058.       IF NOT ZGetExtDesc THEN _
  1059.          GOTO 20710
  1060.       ZMsgHeader$ = "Extra Information for " + ZFileNameHold$     ' KG072003   ' Bh
  1061.       ZSysopComment = ZTrue
  1062.       ZMaxMsgLines = ZMaxExtendedLines
  1063.       WasLL = ZRightMargin
  1064. '      ZRightMargin = 30 + ZMaxDescLen
  1065.       ZRightMargin = 24 + ZMaxDescLen          ' Bh 082790
  1066.       ZFileSysParm = 5
  1067.       RETURN
  1068. 20705 ZMaxMsgLines = ZMaxMsgLinesDef
  1069.       ZRightMargin = WasLL
  1070.       CALL UpdtUpload (ZCategoryName$(),ZCategoryCode$(),ZLinesInMsg,3)  'Pe 02/04/90
  1071. 20710 AddingDescOnly = ZFalse
  1072.       IF ZBytesInFile# > 0.0 THEN _
  1073.          GOTO 21770
  1074. 20730 GOSUB 21780
  1075.       CALL QuickTPut1 ("Upload aborted")
  1076.       ZPrivateDoor = ZFalse
  1077. 20735 CALL KillWork (ZFileName$)
  1078.       IF ZErrCode <>0 THEN _
  1079.          ZWasEL = 20736 : _
  1080.          GOTO 21900
  1081.       ZAnsIndex = ZLastIndex + 1                                     ' KG031501
  1082.       ZLastIndex = 0
  1083.       RETURN
  1084. '
  1085. ' *  Sysop ABORTED UPLOAD
  1086. '
  1087. 20745 ZOutTxt$ = ZXOff$ + _
  1088.            "SYSOP aborted upload. Stop tranfer. <Ctrl-K> continues"
  1089.       GOTO 20675
  1090. '
  1091. ' *  CALCULATE DOWNLOAD TIME ESTIMATE
  1092. '
  1093. 20750 ZStartOfHeader$ = CHR$(1 - (ZInternalProt$ = "Y"))
  1094.       CALL OpenRSeq (ZFileName$,MaxBlock,ZWasDF,ZFLen)
  1095. 20760 IF ZErrCode <> 0 THEN _
  1096.          CALL QuickTPut1 ("Unable to access "+ZFileNameHold$) : _
  1097.          CALL UpdtCalr ("Unable to access "+ZFileName$,2) : _
  1098.          ZOK = ZFalse : _
  1099.          ZErrCode = 0 : _
  1100.          ZBytesInFile# = 0 : _
  1101.          RETURN
  1102.       ZBytesInFile# = LOF(2)
  1103.       ZNumDnldBytes! = LOF(2)
  1104.       ZOK = ZTrue
  1105.       IF SizeOnly THEN _
  1106.          SizeOnly = ZFalse : _
  1107.          RETURN
  1108.       ZBlocksInFile# = MaxBlock
  1109.       IF ZBatchTransfer THEN _
  1110.          Temp# = BatchBlocks# + ZBlocksInFile# : _
  1111.          CALL CheckTimeRemain (MinsRemaining) : _
  1112.          IF (NOT PersonalDnld) AND _
  1113.             (INT(Temp# / 60) + 1 > MinsRemaining) THEN _
  1114.             CALL QuickTPut1 ("Omitting " + ZFileNameHold$ + ".  Insufficient time") : _
  1115.             RETURN _
  1116.          ELSE BatchBlocks# = Temp# : _
  1117.               BatchBytes# = BatchBytes# + ZBytesInFile# : _
  1118.               CALL OpenWorkA (ZNodeWorkFile$) : _
  1119.               CALL PrintWorkA (ZFileName$) : _
  1120.               ZDownFiles = ZDownFiles + 1 : _
  1121.               RETURN
  1122.       ZDownFiles = 1
  1123. 20780 ZOutTxt$ = "File Size    :"
  1124.       ZOK = ZTrue
  1125.       IF ZBlockSize > 0 THEN _
  1126.          ZOutTxt$ = ZOutTxt$ + _
  1127.               STR$(FIX(ZBlocksInFile#)) + _
  1128.               " blocks "
  1129. 20785 ZBlocksInFile# = ZBlocksInFile# / _
  1130.                         VAL(MID$("00000300045012002400480096019203840", -4 * ZBPS, 4))
  1131.       ZBlocksInFile# = ZBlocksInFile# * ZFLen / ZSpeedFactor!
  1132.       IF (ZAnsIndex > 1 AND ZConcatFIles) THEN _
  1133.          RETURN
  1134.       ZOutTxt$ = ZOutTxt$ + _
  1135.            STR$(ZBytesInFile#) + _
  1136.            " bytes"
  1137.       GOSUB 21650
  1138.       IF ZFileSysParm > 1 THEN _
  1139.          RETURN
  1140.       IF ZBytesInFile# < 1 THEN _
  1141.          RETURN
  1142. 20790 ZSubParm = 2
  1143.       CALL Line25
  1144.       ZOutTxt$ = "Transfer Time:" + _
  1145.          STR$(INT(ZBlocksInFile# / 60)) + _
  1146.          " min," + _
  1147.          STR$(INT(ZBlocksInFile# - (INT(ZBlocksInFile# / 60) * 60))) + _
  1148.          " sec (approx)"
  1149.       GOSUB 21650
  1150.       IF ZFileSysParm > 1 THEN _
  1151.          RETURN
  1152. 20791 IF PersonalDnld THEN _
  1153.       Call AutoLogOff : _         'Pe 02/06/90
  1154.          RETURN
  1155.       CALL CheckTimeRemain (MinsRemaining)
  1156.       IF ZSubParm = -1 THEN _
  1157.          ZFileSysParm = 6 : _
  1158.          RETURN
  1159.       ZOK = ZTrue
  1160.       IF (INT(ZBlocksInFile# / 60) + 1) > MinsRemaining THEN _
  1161.          ZOutTxt$ = "Not enough time left!" : _
  1162.          CALL UpdtCalr (ZFileName$ + " " + ZOutTxt$,2) : _
  1163.          CALL QuickTPut1 (ZOutTxt$): _
  1164.          ZOutTxt$ = "" : _
  1165.          ZOK = ZFalse : _
  1166.          ZAutoLogoffReq = ZFalse : _
  1167.          RETURN
  1168. '****************************** TELL THEM mod *****************************  ' Bh
  1169. '
  1170.      ZNotify$ =  ZWelcomeFileDrvPath$ + _
  1171.          "TELTHEM.DEF"                              'Pe 06/12/89
  1172.     ZStopInterrupts = ZTrue                         'Pe 06/12/89
  1173.     CALL BUFFILE (ZNotify$,WasX)                    'Pe 06/12/89
  1174. '
  1175. '**********************  END OF MOD  **************************************  ' Bh
  1176.       CALL AutoLogoff         'Pe 02/16/90
  1177.       CALL QuickTPut1 ("New statistics will be")
  1178.       CALL CheckRatio (ZTrue)
  1179.       RETURN
  1180. 20810 ZDelay! = TIMER + 6
  1181. 20840 CALL EofComm (Char)
  1182.       IF Char = -1 THEN _
  1183.          GOTO 20850
  1184.       CALL FlushCom(ZWasY$)
  1185.       RETURN
  1186. 20850 CALL CheckTime (ZDelay!, TempElapsed!, 1)
  1187.       IF TempElapsed! > 0 THEN GOTO 20840
  1188. 20851 ZWasY$ = ""
  1189.       CALL CheckCarrier
  1190.       IF ZSubParm = -1 THEN _
  1191.          ZFileSysParm = 7 : _
  1192.          RETURN
  1193.       RETURN
  1194. '
  1195. ' *  Xmodem/YMODEM UPLOAD
  1196. '
  1197. 20860 GOSUB 20992
  1198.       IF ZFileSysParm > 1 THEN _
  1199.          RETURN
  1200.       IF NOT ZEightBit THEN _
  1201.          GOSUB 21280 : _
  1202.          IF ZFileSysParm > 1 THEN _
  1203.             RETURN
  1204. 20900 WasX$ = ""
  1205.       Sec = 1
  1206.       'CALL OpenOutW (ZFileName$)
  1207.       IF ZFLen > ZWriteBufDef THEN _
  1208.          WriteBuf = ZFLen _
  1209.       ELSE WriteBuf = ZWriteBufDef
  1210.       CALL OpenRSeq (ZFileName$,WasY,ZWasDF,WriteBuf)
  1211.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _
  1212.          ZWasEL = 20900 : _
  1213.          GOTO 21900
  1214.       FIELD #2, WriteBuf AS ZUpldRec$
  1215.       RecsWrit = 0
  1216.       NumInBuff = 0
  1217.       TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1218.       Year$ = " " + _
  1219.             CHR$(1) + _
  1220.             CHR$(2) + _
  1221.             ZEndTransmission$ + _
  1222.             ZCancel$
  1223. 20903 CALL PutCom (ZNAK$)
  1224. 20920 WasX = 1
  1225. 20922 CALL CheckCarrier
  1226.       IF ZSubParm = -1 THEN _
  1227.          ZFileSysParm = 7 : _
  1228.          RETURN
  1229.       CALL FindFKey
  1230.       IF ZKeyPressed$ = ZEscape$ THEN _
  1231.          GOSUB 20510 :_
  1232.          IF ZFileSysParm > 1 THEN _
  1233.             RETURN _
  1234.          ELSE GOTO 21240
  1235.       GOSUB 20810
  1236.       IF ZFileSysParm > 1 THEN _
  1237.          RETURN
  1238. 20930 WasJ = INSTR(Year$,LEFT$(ZWasY$,1))
  1239.       ON WasJ GOTO 20960,20999,20999,21220,21230
  1240. 20960 IF ZWasY$ <> "" THEN _
  1241.          GOSUB 21280 : _
  1242.          IF ZFileSysParm > 1 THEN _
  1243.             RETURN _
  1244.          ELSE CALL CheckTime (TransferAbort!,TempElapsed!,1) : _
  1245.               ON ZSubParm GOTO 20920,21230
  1246. 20970 WasX = WasX + 1
  1247.       CALL DelayTime (1)
  1248.       CALL PutCom (ZNAK$)
  1249.       IF WasX < 6 THEN _
  1250.          GOTO 20922
  1251.       WasD$ = "Upload Timeout"
  1252.       GOSUB 21710
  1253.       IF ZFileSysParm > 1 THEN _
  1254.          RETURN
  1255.       CALL CheckTime (TransferAbort!,TempElapsed!,1)
  1256.       ON ZSubParm GOTO 20990,21230
  1257. 20990 GOTO 20920
  1258. '
  1259. ' *  CHANGE TO 8 BIT FOR Xmodem
  1260. '
  1261. 20992 GOSUB 20510
  1262.       IF ZFileSysParm > 1 THEN _
  1263.          ZFileSysParm = 2 : _
  1264.          RETURN
  1265.       IF NOT ZEightBit THEN _
  1266.          PrevLineCntl = INP (ZLineCntlReg) : _
  1267.          CALL DelayTime (3) : _
  1268.          SwitchToEight = ZTrue : _
  1269.          OUT ZLineCntlReg,3
  1270. 20996 WasSO = 0
  1271.       RETURN
  1272. '
  1273. ' *  EXPECTED BLOCK LENGTH. 132 FOR CheckSum, 133 FOR CRC, 1029 FOR YMODEM
  1274. '
  1275. 20999 SOL = 896 * WasJ - 1659 + ZCheckSum
  1276.       DataSol = 128 - (SOL > 1024)*896
  1277.       GOTO 21020
  1278. '
  1279. ' *  Xmodem/YMODEM UPLOAD
  1280. '
  1281. 21000 GOSUB 20810
  1282.       IF ZFileSysParm > 1 THEN _
  1283.          RETURN
  1284.       IF ZWasY$ = "" THEN _
  1285.          WasD$ = "Upload Timeout" : _
  1286.          GOSUB 21710 : _
  1287.          IF ZFileSysParm > 1 THEN _
  1288.             RETURN _
  1289.          ELSE GOTO 21040
  1290. 21020 WasX$ = WasX$ + _
  1291.            ZWasY$
  1292.       IF LEN(WasX$) < SOL THEN _
  1293.          GOTO 21000
  1294. 21040 IF LEN(WasX$) = SOL THEN _
  1295.          GOTO 21090
  1296. 21050 IF LEN(WasX$) > SOL THEN _
  1297.          GOTO 21180
  1298. 21060 IF WasX$ = ZEndTransmission$ THEN _
  1299.          GOTO 21220
  1300. 21070 IF WasX$ = ZCancel$ THEN _
  1301.          GOTO 21230
  1302. 21080 GOTO 21170
  1303. 21090 WasJX = ASC(MID$(WasX$,2,1))
  1304.       IF Sec = WasJX THEN _
  1305.          GOTO 21100
  1306.       GOTO 21200
  1307. 21100 IF (Sec XOR 255) <> ASC(MID$(WasX$,3,1)) THEN _
  1308.          GOTO 21210
  1309. 21110 IF ZCheckSum THEN _
  1310.          WasWK$ = MID$(WasX$,4,128) : _
  1311.          GOSUB 21750 : _
  1312.          IF ZFileSysParm > 1 THEN _
  1313.             RETURN _
  1314.          ELSE IF XmodemChecksum <> ASC(MID$(WasX$,132,1)) THEN _
  1315.             GOTO 21190 _
  1316.          ELSE GOTO 21120
  1317.       WasWK$ = MID$(WasX$,4)
  1318.       GOSUB 21750
  1319.       IF ZFileSysParm > 1 THEN _
  1320.          RETURN
  1321. 21113 IF CRCValue <> 0 THEN _
  1322.          GOTO 21191
  1323. 21120 WasSO = WasSO + 1
  1324.       CALL PutCom (ZAcknowledge$)
  1325. 21131 IF NumInBuff >= WriteBuf THEN _
  1326.          NumInBuff = 0 : _
  1327.          CALL PutWork (ZUpldRec$,RecsWrit,WriteBuf) : _
  1328.          IF ZErrCode <> 0 THEN _
  1329.             ZWasEL = 21131 : _
  1330.             GOTO 21900
  1331.       MID$(ZUpldRec$,NumInBuff+1,DataSol) = WasWK$
  1332.       NumInBuff = NumInBuff + DataSol
  1333. 21145 Sec = 255 AND (Sec + 1)
  1334.       CALL QuickLPrnt ("OK Rec Blk #",WasSO)
  1335. 21150 WasX$ = ""
  1336.       XmodemChecksum = 0
  1337.       TransferAbort! = TIMER + 45
  1338.       GOTO 20920
  1339. 21170 ZOutTxt$ = "Short Blk #"
  1340.       GOTO 21212
  1341. 21180 ZOutTxt$ = "Long Blk #"
  1342.       GOTO 21212
  1343. 21190 ZOutTxt$ = "Chksum Error #"
  1344.       GOTO 21212
  1345. 21191 ZOutTxt$ = "CRC Error"
  1346.       GOTO 21212
  1347. 21200 IF Sec < WasJX THEN _ 
  1348.          ZOutTxt$ = "Blk # Error in #" : _
  1349.          GOTO 21212
  1350.       CALL PutCom (RIGHT$(ZAckChar$,1 - (WasJX = 0)))
  1351.       GOTO 21150
  1352. 21210 ZOutTxt$ = "Complement Error in #"
  1353. 21212 CALL PutCom (ZNAK$)
  1354.       CALL LPrnt(ZLineFeed$ + ZOutTxt$ + STR$(WasSO + 1),0)
  1355.       GOTO 21150
  1356. 21220 IF NumInBuff < 1 THEN _
  1357.          GOTO 21225
  1358.       WasWK$ = LEFT$(ZUpldRec$,NumInBuff)
  1359.       CALL OpenRSeq (ZFileName$,MaxBlock,ZWasDF,128)
  1360.       FIELD #2, 128 AS ZUpldRec$
  1361.       MaxBlock = CDBL(RecsWrit) * WriteBuf / 128
  1362.       FOR WasI = 1 TO NumInBuff/128
  1363.          CALL PutWork (MID$(WasWK$,128*WasI-127,128),MaxBlock,128)
  1364.          IF ZErrCode > 0 THEN _
  1365.             ZWasEL = 21220 : _
  1366.             GOTO 21900
  1367.       NEXT
  1368.       CLOSE 2
  1369. 21225 CALL PutCom (ZAcknowledge$)
  1370.       GOTO 21250
  1371. 21230 WasD$ = ZLineFeed$ + _
  1372.            "Transfer Aborted"
  1373.       GOSUB 21710
  1374.       IF ZFileSysParm > 1 THEN _
  1375.          RETURN
  1376. 21240 CALL EofComm (Char)
  1377.       IF Char <> -1 THEN _
  1378.          GOSUB 21280 : _
  1379.          IF ZFileSysParm > 1 THEN _
  1380.             RETURN _
  1381.          ELSE CALL DelayTime (1) : _
  1382.          GOTO 21240
  1383.       CALL PutCom (ZCancel$ + ZCancel$)
  1384.       CALL DelayTime (1)
  1385.       CALL EofComm (Char)
  1386.       IF Char <> -1 THEN _
  1387.          GOTO 21240
  1388.       ZOK = ZFalse
  1389. 21250 ZEightBit = ZTrue
  1390.       RETURN
  1391. '
  1392. ' *  CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER
  1393. '
  1394. 21280 CALL CheckCarrier
  1395.       IF ZSubParm = -1 THEN _
  1396.          ZFileSysParm = 7 : _
  1397.          RETURN
  1398.       CALL EofComm (Char)
  1399.       IF Char = -1 THEN _
  1400.          RETURN
  1401. 21281 CALL FlushCom(ZWasDF$)
  1402.       GOTO 21280
  1403. '
  1404. ' *  Xmodem/YMODEM DOWNLOAD
  1405. '
  1406. 21300 GOSUB 20992
  1407.       IF ZFileSysParm > 1 THEN _
  1408.          RETURN
  1409.       Sec = 0
  1410.       GOSUB 21280
  1411.       IF ZFileSysParm > 1 THEN _
  1412.          RETURN
  1413.       ZNAK$ = CHR$(21)
  1414.       TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1415.    CALL OpenRSeq (ZFileName$,MaxBlock,ZWasDF,ZFLen)  'Pe 08/15/89
  1416. 21303 FIELD 2,ZFLen AS ZDnldRecord$
  1417. '
  1418. ' *  ROUTINE TO START AN "Xmodem" OR "YMODEM" DOWNLOAD.  CHECK'S INITIAL
  1419. ' *  "HANDSHAKE" TO SEE IF CHARACTER IS SENT IS A:
  1420. ' *           "X" = Xmodem WITH CheckSum AND 128 CHARACTER RECORDS
  1421. ' *           "C" = Xmodem WITH CRC CHECK AND 128 CHARACTER RECORDS
  1422. ' *           "Y" = YMODEM WITH CRC CHECK AND 1024 CHARACTER RECORDS
  1423. '
  1424. 21350 CALL EofComm (Char)
  1425.       WHILE Char <> -1
  1426. 21360    CALL GetCom(ZWasY$)
  1427.          IF ZWasY$ = ZCancel$ THEN _
  1428.             GOTO 21560
  1429. 21380    ZCheckSum = (ZWasY$ = ZNAK$)
  1430.          IF ZCheckSum THEN _
  1431.             ZFF = INSTR(ZInternalEquiv$,"X") : _
  1432.             IF ZFF > 0 THEN _
  1433.                ZWasFT$ = MID$(ZDefaultXfer$,ZFF,1) : _
  1434.                GOTO 21480 _
  1435.             ELSE ZWasFT$ = "X" : _
  1436.                  GOTO 21480 _
  1437.          ELSE IF ZWasY$ = "C" THEN _
  1438.                  GOTO 21480
  1439.          CALL EofComm (Char)
  1440. 21390 WEND
  1441.       GOSUB 21460
  1442.       IF ZFileSysParm > 1 THEN _
  1443.          RETURN
  1444.       IF ZKeyPressed$ = ZEscape$ THEN _
  1445.          RETURN
  1446.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1447.       ON ZSubParm GOTO 21350,21455
  1448. 21410 TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1449. '
  1450. ' *  ROUTINE TO WAIT FOR AN ACKNOWLEDGEMENT ON AN "Xmodem" OR "YMODEM"
  1451. ' *  DOWNLOAD
  1452. '
  1453. 21415 CALL EofComm (Char)
  1454.       IF Char <> -1 THEN _
  1455.          GOTO 21420
  1456.       GOSUB 21460
  1457.       IF ZFileSysParm > 1 THEN _
  1458.          RETURN
  1459.       IF ZKeyPressed$ = ZEscape$ THEN _
  1460.          RETURN
  1461.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1462.       ON ZSubParm GOTO 21415,21455
  1463. 21420 CALL GetCom(ZWasY$)
  1464.       IF ZWasY$ = ZAcknowledge$ THEN _
  1465.          GOTO 21470
  1466. 21440 IF ZWasY$ <> ZNAK$ THEN _
  1467.          GOTO 21450
  1468. 21443 WasD$ = ZLineFeed$ + _
  1469.          "Error -> retrans #" + _
  1470.          STR$(WasSO)
  1471.       GOSUB 21710
  1472.       IF ZFileSysParm > 1 THEN _
  1473.          RETURN
  1474. 21445 WasSO = WasSO - 1
  1475.       GOTO 21490
  1476. 21450 IF ZWasY$ = ZCancel$ THEN _
  1477.          IF HaveACancel THEN _
  1478.             GOTO 21560 _
  1479.          ELSE HaveACancel = ZTrue
  1480.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1481.       ON ZSubParm GOTO 21415,21455
  1482. 21455 WasD$ = "Download timeout"
  1483.       GOSUB 21710
  1484.       IF ZFileSysParm > 1 THEN _
  1485.          RETURN
  1486.       GOTO 21560
  1487. 21460 CALL CheckCarrier
  1488.       CALL FindFKey
  1489.       IF ZSubParm < 0 THEN _
  1490.          ZFileSysParm = 7 : _
  1491.          RETURN
  1492.       IF ZKeyPressed$ = ZEscape$ THEN _
  1493.          GOTO 21540
  1494.       RETURN
  1495. '
  1496. ' *  DISPLAY BLOCK SENT OK AND THEN READ IN NEXT RECORD FROM DISK TO DOWNLOAD
  1497. '
  1498. 21470 CALL QuickLPrnt ("OK Sent Blk #",WasSO)
  1499. 21480 IF LOC(2) => MaxBlock THEN _
  1500.          GOTO 21530
  1501.       CALL GetWork (ZFLen)
  1502.       IF ZErrCode <> 0 THEN _
  1503.          ZWasEL = 21480 : _
  1504.          GOTO 21900
  1505.       Sec = 255 AND (Sec + 1)
  1506.       GOTO 21490
  1507. '
  1508. ' *  ROUTINE TO WRITE OUT AN "Xmodem" OR "YMODEM" RECORD TO THE COMM. PORT
  1509. '
  1510. 21490 WasSO = WasSO + 1
  1511.       CALL PutCom (ZStartOfHeader$ + CHR$(Sec) + CHR$(Sec XOR 255))
  1512.       CALL PutCom (ZDnldRecord$)
  1513.       HaveACancel = ZFalse
  1514. 21503 WasWK$ = ZDnldRecord$
  1515. 21504 GOSUB 21750
  1516.       IF ZFileSysParm > 1 THEN _
  1517.          RETURN
  1518. 21510 IF ZCheckSum THEN _
  1519.          CALL PutCom(CHR$(XmodemChecksum)) _
  1520.       ELSE CALL PutCom(CHR$(CRCHigh) + CHR$(CRCLow))
  1521.       GOSUB 21280
  1522.       IF ZFileSysParm > 1 THEN _
  1523.          RETURN
  1524.       GOTO 21410
  1525. '
  1526. ' *  END-OF-FILE FOR Xmodem Dnlds -- SEND THE "EOT" CHARACTER AND WAIT UP
  1527. ' *  TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK").  IF NONE IS
  1528. ' *  RE-TRY UP TO 10 TIMES.  IF No POSITIVE RESPONSE IS RECEIVED AFTER TEN
  1529. ' *  Attempts, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL.
  1530. '
  1531. 21530 CALL PutCom (ZEndTransmission$)
  1532.       WasX = 1
  1533. 21531 GOSUB 20810
  1534.       IF ZFileSysParm > 1 THEN _
  1535.          RETURN
  1536.       IF INSTR(ZWasY$,ZAcknowledge$) THEN _
  1537.          GOTO 21550
  1538.       CALL FindFKey
  1539.       IF ZSubParm < 0 THEN _
  1540.          ZFileSysParm = 2 : _
  1541.          RETURN
  1542.       IF ZKeyPressed$ = ZEscape$ THEN _
  1543.          GOSUB 21540 : _
  1544.          GOTO 21545
  1545.       IF WasX < 10 THEN _
  1546.          WasX = WasX + 1 : _
  1547.          GOTO 21531
  1548.       ZDnldCompleted = ZFalse  'Pe 02/05/90
  1549.       GOTO 21230
  1550. 21540 GOSUB 20510
  1551.       IF ZFileSysParm > 1 THEN _
  1552.          RETURN
  1553.       RETURN
  1554. 21545 ZWasY$ = ZCancel$
  1555.       CALL PutCom (ZCancel$ + ZCancel$ + ZCancel$)
  1556.       ZDnldCompleted = ZFalse 'Pe 02/05/90
  1557.       GOTO 21250              'Pe 02/05/90
  1558. 21550 ZDnldCompleted = ZTrue
  1559.       GOTO 21250
  1560. 21560 ZDnldCompleted = ZFalse   'Pe 02/05/90
  1561.       WasD$ = ZLineFeed$ + _
  1562.            "Caller aborted trans"
  1563.       GOSUB 21710
  1564.       IF ZFileSysParm > 1 THEN _
  1565.          RETURN
  1566.       GOTO 21545
  1567. '
  1568. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE
  1569. '
  1570. ' Modeled on lines 12975 to 12983 in RBBS-PC.BAS
  1571. 21630 ZSubParm = 1
  1572.       GOTO 21655
  1573. 21640 ZSubParm = 3
  1574.       GOTO 21655
  1575. 21650 ZSubParm = 5
  1576. 21655 CALL TPut
  1577.       IF ZSubParm < 0 THEN _
  1578.          ZFileSysParm = 2 : _
  1579.          RETURN
  1580.       IF ZSubParm = 8 THEN _
  1581.          GOSUB 21660
  1582.       RETURN
  1583. '
  1584. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE
  1585. '
  1586. ' Modeled on lines 12995 to 12997 in RBBS-PC.BAS
  1587. 21660 ZSubParm = 1
  1588.       CALL TGet
  1589. 21665 IF ZSubParm < 0 THEN _
  1590.          ZFileSysParm = 2
  1591.       RETURN
  1592. 21668 CALL PopCmdStack
  1593.       GOTO 21665
  1594. 21700 ZErrCode = 0
  1595.       ZLastIndex = 0
  1596.       RETURN
  1597. '
  1598. ' **** COMMON LOCAL DISPLAY PRINT ***
  1599. '
  1600. '  (formerly lines 1315 to 1320 in RBBS-PC.BAS
  1601. 21710 NumReturns = 1
  1602. 21720 CALL LPrnt (WasD$,NumReturns)
  1603.       RETURN
  1604. '
  1605. ' *  Xmodem / CRC INTERFACE
  1606. '
  1607. '  (formerly line 46000 in RBBS-PC.BAS
  1608. 21750 XmodemChecksum = 0
  1609.       CRCValue = 0
  1610.       CALL Xmodem(WasWK$,XmodemChecksum,CRCValue,CRCHigh,CRCLow)
  1611.       RETURN
  1612. '
  1613. ' * UPDATE DOWNLOAD STATISTICS
  1614. '
  1615. '  (formerly lines 50600 to 50614 in RBBS-PC.BAS
  1616. 21760 GOSUB 21780
  1617.       IF ZFileSysParm > 1 THEN _
  1618.          RETURN
  1619.       IF ZBatchTransfer THEN _
  1620.          CALL LinesInFile (ZNodeWorkFile$,ZDownFiles) _
  1621.       ELSE ZDownFiles = 1
  1622.       IF NOT ZDnldCompleted THEN _    'Pe 02/05/90
  1623.          ZAutoLogoffReq = ZFalse : _
  1624.          ZWasDF$ = " Aborted" : _
  1625.          GOTO 21768
  1626.       CALL LogPDown (PersonalDnld,1+ZAnsIndex-FirstDnld)
  1627.          GOSUB 21778
  1628.          ZDnlds = ZDnlds + ZDownFiles
  1629.          ZGlobalDLToday! = ZGlobalDLToday! + ZDownFiles
  1630.          ZGlobalDnlds = ZGlobalDnlds + ZDownFiles
  1631.          ZDLBytes! = ZDLBytes! + ZNumDnldBytes! 
  1632.          ZGlobalDLBytes! = ZGlobalDLBytes! + ZNumDnldBytes! 
  1633.          ZDLToday! = ZDLToday! + ZDownFiles
  1634.          ZBytesToday! = ZBytesToday! + ZNumDnldBytes! 
  1635.          ZGlobalBytesToday! = ZGlobalBytesToday! + ZNumDnldBytes!
  1636.       ZNumDnldBytes! = 0
  1637. '      CALL Muzak (6)
  1638.       ZWasDF$ = " Downloaded"
  1639.       IF (ZAnsIndex = LastDnld OR NOT ZConcatFIles) THEN _
  1640.          CALL SkipLine (1) : _
  1641.          CALL QuickTPut1 ("Download successful")   ' PE 02/16/90
  1642.        '  IF WasX THEN _
  1643.        '     CALL QuickTPut1 ("but not counted against ratios")
  1644. 21768 'IF ZAutoDownInProgress THEN _
  1645.       '   ZWasDF$ = " AUTO" + _          ' Pe 02/04/90
  1646.       '        MID$(ZWasN$,2)
  1647. '      IF INSTR(ZWasN$,"Aborted") THEN _
  1648. '         ZAutoDownInProgress = 0
  1649.       ZOutTxt$ = ""
  1650. 21770 CALL AMorPM
  1651.       IF NOT ZBatchTransfer THEN _
  1652.          GOTO 21773
  1653.       CALL OpenWork (2,ZNodeWorkFile$)
  1654.       IF ZErrCode > 0 THEN _
  1655.          RETURN
  1656.       ZWasQ = 0
  1657.       WHILE NOT EOF(2)
  1658.          CALL ReadAny
  1659.          ZWasQ = ZWasQ + 1
  1660.          ZUserIn$(ZWasQ) = ZOutTxt$
  1661.       WEND
  1662. 21772 IF ZWasQ < 1 THEN _
  1663.          ZBatchTransfer = ZFalse : _
  1664.           RETURN
  1665.       CALL OpenWork (2,ZUserIn$(ZWasQ))
  1666.       IF ZErrCode > 0 THEN _
  1667.          ZErrCode = 0 : _
  1668.          ZWasQ = ZWasQ - 1 : _
  1669.          GOTO 21772
  1670.       ZBytesInFile# = LOF(2)
  1671.       ZFileName$ = ZUserIn$(ZWasQ)
  1672. 21773 CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZTrue)
  1673.       ZWasZ$ = WasX$ + _
  1674.            Extension$ + _
  1675.            ZWasDF$ + _
  1676.            " at " + _
  1677.            ZTime$ + _
  1678.            " using " + _
  1679.            ZWasFT$ + _
  1680.            STR$(ZBytesInFile#)
  1681.       CALL UpdtCalr (ZWasZ$,2)
  1682.       IF ZBatchTransfer THEN _
  1683.          ZWasQ = ZWasQ - 1 : _
  1684.          GOTO 21772
  1685. '      CALL CheckRatio (ZFalse)
  1686. 21774 IF ZMenuIndex = 6 THEN _
  1687.          IF ZDnldCompleted THEN _      'Pe 02/05/90
  1688.             ZOutTxt$ = WasX$ : _
  1689.             ZSubParm = 5 : _
  1690. '            CALL Library
  1691.       RETURN
  1692. '********************************************************************
  1693. 21778   CALL AllCaps (ZFileNameHold$)
  1694.       IF ZFileNameHold$ = "ALLFILES.ZIP" OR_
  1695.          ZfileNameHold$ = "ALLFILES" OR _
  1696.      ZFileNameHold$ = "PKZ102.EXE"  THEN _
  1697.      CALL SkipLine(1) :_
  1698.      CALL QuickTPut ("Downloading " +ZFileNameHold$ +" is NOT Charged Against your Stats!",2) :_
  1699.          CALL DelayTime (2) : _
  1700.          DownFiles = DownFiles - 1 :_
  1701.  IF DownFiles < 0 THEN_
  1702.  DownFiles = 0
  1703.  RETURN
  1704. '
  1705. '
  1706. ' *****   TURN ON INTERMEDIATE ECHO   ****
  1707. '
  1708. '  (formerly line 50620 in RBBS-PC.BAS
  1709. 21780 IF ZEchoer$ = "I" THEN _
  1710.          CALL SetEcho ("I")
  1711. '
  1712. ' *  RESTORE COMMUNICATIONS AFTER Switch TO 8 BIT
  1713. '
  1714. '  (formerly between lines 50620 and 50630 in RBBS-PC.BAS
  1715.       IF SwitchToEight THEN _
  1716.          IF ZSwitchBack THEN _
  1717.             OUT ZLineCntlReg, PrevLineCntl : _
  1718.             CALL DelayTime (3) : _
  1719.             ZEightBit = ZFalse : _
  1720.             SwitchToEight = ZFalse
  1721.       RETURN
  1722. '
  1723. ' *****  TURN OFF INTERMEDIATE ECHO  ****
  1724. '
  1725. '  (formerly line 50630 in RBBS-PC.BAS
  1726. 21790 IF ZEchoer$ = "I" THEN _
  1727.          CALL SetEcho ("R")
  1728.       RETURN
  1729. '
  1730. ' *****   DIRECTORY SEARCH   ****
  1731. '
  1732. '  (formerly lines 52900 to 52920 in RBBS-PC.BAS
  1733. 21800 WasCK = 2
  1734. 21810 ZOutTxt$ = "Text string to search for" + ZCrLf$  ' Bh
  1735.       ZOutTxt$ = ZOutTxt$ + "(wildcards allowed if it's a file name, [RETURN] to quit)"  ' Bh
  1736.       ZMacroMin = 99
  1737.       GOSUB 21668                                                    ' KG081201
  1738.       IF ZWasQ = 0 THEN _
  1739.          RETURN
  1740. 21820 WasRS$ = ZUserIn$(ZAnsIndex)
  1741.       WildSearch = (INSTR(WasRS$,"*") > 0 OR INSTR(WasRS$,"?") > 0)
  1742.       CALL AllCaps (WasRS$)
  1743.       SearchString$ = WasRS$
  1744.       SearchDate$ = ""
  1745.       ZJumpSearching = ZFalse
  1746.       WasA1$ = WasRS$
  1747.       GOTO 21867
  1748. '
  1749. ' *****  P - personal download  ****
  1750. '
  1751. '  (formerly lines 52950 to 52952 in RBBS-PC.BAS
  1752. 21850 IF ZPersonalBegin < 1 OR ZPersonalLen < 1 THEN _
  1753.          RETURN
  1754.       DnldFlag = 0
  1755.       PersonalDnld = ZTrue
  1756. 21852 CALL PersFile (MID$(ZUserRecord$,ZPersonalBegin,ZPersonalLen),_
  1757.                      DnldFlag)
  1758.       IF ZSubParm = -1 THEN _
  1759.          ZFileSysParm = 7: _
  1760.          RETURN
  1761.       IF ZLastIndex <= 0 THEN _
  1762.          GOTO 21854
  1763.       ZConcatFIles = ZPersonalConcat
  1764.       ZStopInterrupts = ZTrue
  1765.       TimeLockExempt = ZTrue
  1766.       GOSUB 20202
  1767.       IF ZFileSysParm > 1 THEN _
  1768.          GOTO 21854
  1769.       TimeLockExempt = ZFalse
  1770.       ZConcatFIles = ZFalse
  1771.       GOTO 21852
  1772. 21854 PersonalDnld = ZFalse
  1773.       RETURN
  1774. '
  1775. ' *  N - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE Last DIR DISPLAY)
  1776. '
  1777. '  (formerly lines 53000 to 53070 in RBBS-PC.BAS
  1778. 21860 WasCK = 1
  1779. 21862 WasA1$ = RIGHT$(ZWasLM$,4) +_
  1780.             LEFT$(ZWasLM$,2)
  1781.       ZOutTxt$ = "Files on/after MMDDYY, [ENTER] = " + WasA1$
  1782.       GOSUB 21668
  1783.       CALL AllCaps (ZUserIn$(ZAnsIndex))
  1784.       IF ZWasQ = 0 OR ZUserIn$(ZAnsIndex) = "S" THEN _
  1785.          WasRS$ = ZWasLM$ : _
  1786.          GOTO 21866
  1787. 21865 IF LEN(ZUserIn$(ZAnsIndex)) <> 6 THEN _
  1788.          GOTO 21862
  1789.       WasA1$ = ZUserIn$(ZAnsIndex)
  1790.       WasRS$ = RIGHT$(WasA1$,2) + _
  1791.             LEFT$(WasA1$,4)
  1792. 21866 SearchDate$ = WasRS$            'Pe 03/18/90
  1793.       SearchString$ = ""
  1794.       ZJumpSearching = ZFalse
  1795. 21867 CALL GetDirs (ZFalse)            'Pe 02/05/90
  1796.       IF ZWasQ = 0 THEN _
  1797.          RETURN
  1798. 21871 CALL ConvertDir (ZAnsIndex)
  1799.       ZListDir = ZTrue
  1800.       ListNew = ZTrue
  1801.       ZSearchingAll = ZFalse
  1802. 21875 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1803.       IF NOT ZSearchingAll THEN _
  1804.          IF ZWasZ$ = "ALL" THEN _
  1805.             IF NOT ZLimitSearchToFMS THEN _
  1806.                GOSUB 21890
  1807. 21880 WasQX = ZAnsIndex
  1808.       GOSUB 20157
  1809.       IF ZFileSysParm > 1 THEN _
  1810.          RETURN
  1811.       ZAnsIndex = ZAnsIndex + 1
  1812.       IF ZAnsIndex <= ZLastIndex THEN _
  1813.          GOTO 21875
  1814.       ListNew = ZFalse
  1815.       SearchString$ = ""
  1816.       SearchDate$ = ""
  1817.       RETURN
  1818. 21890 WasG = ZAnsIndex
  1819.       CALL GetAll (ZUserIn$(),WasG)
  1820.       ZSearchingAll = ZTrue
  1821.       ZLastIndex = WasG
  1822.       ZAnsIndex = ZAnsIndex + 1
  1823.       RETURN
  1824. '
  1825. ' *  MAIN FILE SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE
  1826. '
  1827. '  (formerly lines 13000 to 13500 in RBBS-PC.BAS
  1828. 21900 IF ZDebug THEN _
  1829.          ZOutTxt$ = "RBBSSUB5 DEBUG Error Trap Entry ERL=" + _
  1830.               STR$(ZWasEL) + _
  1831.               " ERR=" + _
  1832.               STR$(ZErrCode) : _
  1833.          IF ZPrinter THEN _
  1834.             CALL Printit(ZOutTxt$) _
  1835.          ELSE CALL LPrnt(ZOutTxt$,1)
  1836.       IF ZWasEL = 20126 AND ZErrCode = 53 THEN _
  1837.          GOTO 20142
  1838.       IF ZWasEL = 20242 AND ZErrCode = 62 THEN _
  1839.          CALL UpdtCalr (ZFileSecFile$ + " bad format!",2) : _
  1840.          GOTO 20247
  1841.       IF ZWasEL = 20263 THEN _
  1842.          ZOutTxt$ = "<Download aborted>" : _
  1843.          ZDnldCompleted = ZFalse : _     'Pe 02/05/90
  1844.          GOTO 20390
  1845.       IF ZWasEL = 20452 AND ZErrCode = 53 THEN _
  1846.          GOTO 20451
  1847.       IF ZWasEL = 20560 AND ZErrCode = 67 THEN _
  1848.          GOTO 20451
  1849.       IF ZWasEL = 20560 AND ZErrCode = 70 THEN _
  1850.          IF VAL(ZFreeSpace$) > 1999 THEN _
  1851.             GOTO 20610 _
  1852.          ELSE CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _
  1853.               GOTO 21700
  1854.       IF ZWasEL = 20620 THEN _
  1855.          GOTO 20670
  1856.       IF ZWasEL = 20650 THEN _
  1857.          GOTO 20670
  1858.       IF ZWasEL = 20736 AND ZErrCode = 53 THEN _
  1859.          GOTO 21700
  1860.       IF ZWasEL = 20900 AND ZErrCode = 75 THEN _
  1861.          GOTO 21230
  1862.       IF ZWasEL = 20900 AND ZErrCode = 70 THEN _
  1863.          CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _
  1864.          GOTO 21230
  1865.       IF ZWasEL = 21131 OR ZWasEL = 21220 THEN _
  1866.          ZErrCode = 0 : _
  1867.          GOTO 21230
  1868.       IF ZWasEL = 21480 THEN _
  1869.          CALL LogError : _
  1870.          IF ZErrCode = 57 THEN _
  1871.             CALL QuickTPut1 ("Error reading file.  Aborting download") : _
  1872.             ZDnldCompleted = ZFalse : _   'Pe 02/05/90
  1873.             GOTO 21230
  1874. 21910 CALL LogError
  1875.       CALL QuickTPut1 (ZCallersRecord$)
  1876.       ZFileSysParm = 3
  1877.       RETURN
  1878. 21920 ' EXIT RBBS-PC FILE SUBSYSTEM
  1879.       END SUB
  1880. 63100 ' $SUBTITLE: 'DoorReturn - Subroutine to process requests from a door'
  1881. ' $PAGE
  1882. '
  1883. '  NAME    -- DoorReturn
  1884. '
  1885. '  INPUTS  -- PARAMETER                      MEANING
  1886. '             DOUTx.DEF               File of requests
  1887. '
  1888. '  OUTPUTS -- ZUserSecLevel     Revised Security Level
  1889. '
  1890. '  PURPOSE -- To give Doors a stable way to make requests
  1891. '             to the host.
  1892. '
  1893.       SUB DoorReturn STATIC
  1894.       IF ZPrivateDoor OR NOT ZExitToDoors THEN _
  1895.          EXIT SUB
  1896.       ZFileName$ = "DOUT" + ZNodeID$ + ".DEF"
  1897.       CALL FindIt (ZFileName$)
  1898.       IF NOT ZOK THEN _
  1899.          EXIT SUB
  1900. 63105 IF EOF(2) THEN _
  1901.          GOTO 63195
  1902.       CALL ReadParms (ZOutTxt$(),2,1)
  1903.       IF ZErrCode > 0 THEN _
  1904.          GOTO 63115
  1905.       IF LEN(ZOutTxt$(1)) < 2 THEN _
  1906.          EXIT SUB
  1907.       ZUserIn$ = LEFT$(ZOutTxt$(1),2) + ","
  1908.       WasX = INSTR("SL,UR,",ZUserIn$)
  1909.       IF WasX = 0 THEN _
  1910.          GOTO 63105
  1911.       WasX = WasX\3 + 1
  1912.       ON WasX GOTO 63110,63115
  1913.       GOTO 63105
  1914. 63110 WasX$ = LEFT$(ZOutTxt$(2),1)         ' SL = Security Level
  1915.       CALL CheckInt (ZOutTxt$(2))
  1916.       IF ZErrCode > 0 THEN _
  1917.          GOTO 63105
  1918.       IF WasX$ = "+" OR WasX$ = "-" THEN _
  1919.          ZWasA = ZUserSecLevel + ZTestedIntValue _
  1920.       ELSE ZWasA = ZTestedIntValue
  1921.       IF ZWasA < ZSysopSecLevel THEN _
  1922.          ZAdjustedSecurity = (ZWasA <> ZUserSecLevel) : _
  1923.          IF ZAdjustedSecurity THEN _
  1924.             ZUserSecLevel = ZWasA : _
  1925.             MID$(ZUserRecord$,47,2) = MKI$(ZWasA) : _
  1926.             CALL QuickTPut1 ("Security changed to" + STR$(ZWasA)) : _
  1927.             CALL UpdtCalr ("Door reset security to "+STR$(ZWasA),2)
  1928.       GOTO 63105
  1929. 63115 IF LEN(ZOutTxt$(1)) < 7 THEN _
  1930.          GOTO 63105
  1931.       IF MID$(ZOutTxt$(1),3,1) <> "(" THEN _
  1932.          GOTO 63105
  1933.       WasX = INSTR(4,ZOutTxt$(1),":")
  1934.       IF WasX < 1 THEN _
  1935.          GOTO 63105
  1936.       CALL CheckInt (MID$(ZOutTxt$(1),4,WasX-4))
  1937.       IF ZErrCode > 0 THEN _
  1938.          GOTO 63105
  1939.       IF ZTestedIntValue > 128 OR ZTestedIntValue < 1 THEN _
  1940.          GOTO 63105
  1941.       ZWasA = ZTestedIntValue
  1942.       CALL CheckInt (MID$(ZOutTxt$(1),WasX+1))
  1943.       IF ZErrCode > 0 OR ZTestedIntValue < 1 OR ZTestedIntValue > 128 THEN _
  1944.          GOTO 63105
  1945.       MID$(ZUserRecord$,ZWasA,ZTestedIntValue) = LEFT$(ZOutTxt$(2) + _
  1946.          SPACE$(ZTestedIntValue),ZTestedIntValue)
  1947.       CALL UpdtCalr ("Door set UR"+STR$(ZWasA)+":"+STR$(ZTestedIntValue)+" to <"+ZOutTxt$(2)+">",2)
  1948.       GOTO 63105
  1949. 63195 CALL KillWork (ZFileName$)
  1950.       ZErrCode = 0
  1951.       END SUB
  1952. 63200 ' $SUBTITLE: 'WildCard -- Matches string to a pattern'
  1953. ' $PAGE
  1954. '  NAME    -- WildCard
  1955. '
  1956. '  INPUTS  -- PARAMETER             MEANING
  1957. '             Pattern$           PATTERN TO CHECK
  1958. '             Strng$             STRING TO FIE
  1959. '
  1960. '  OUTPUTS -- ZOK                True IF MATCH Found
  1961. '                                False IF No MATCH WAS Found
  1962. '
  1963. '  PURPOSE  Determine whether a string is an instance in a pattern
  1964. '           supported patterns are only "?" which requires a
  1965. '           character but can be any, and "*" which matches any-
  1966. '           thing, including a null string.  Anything else in a
  1967. '           sting must be an exact match.  Supports reverse
  1968. '           wildcards.
  1969. '
  1970. '
  1971.       SUB WildCard (Pattern$,Strng$) STATIC
  1972. 63285 ZOK = ZTrue
  1973.       PatPos = 0
  1974.       StrPos = 0
  1975.       Inc = 1
  1976.       WasKT = 0
  1977.       WasP = LEN(Pattern$)
  1978.       WasL = LEN(Strng$)
  1979. 63286 PatPos = PatPos + Inc
  1980.       StrPos = StrPos + Inc
  1981.       WasKT = WasKT + 1
  1982.       IF WasKT > WasL THEN _
  1983.          GOTO 63288
  1984.       ZUserIn$ = MID$(Pattern$,PatPos,1)
  1985.       IF ZUserIn$ = "*" THEN _
  1986.          GOTO 63289
  1987. 63287 IF ZUserIn$ <> "?" AND MID$(Strng$,StrPos,1) <> ZUserIn$ THEN _
  1988.          ZOK = ZFalse : _
  1989.          EXIT SUB
  1990.       GOTO 63286
  1991. 63288 IF PatPos >= LEN(Pattern$) OR PatPos < 1 THEN _
  1992.          EXIT SUB
  1993.       IF MID$(Pattern$,PatPos,1) <> "*" THEN _
  1994.          ZOK = ZFalse : _
  1995.          EXIT SUB
  1996. 63289 IF PatPos <> WasP THEN _   ' Reverse search
  1997.          Inc = -1 : _
  1998.          WasP = PatPos : _
  1999.          PatPos = LEN(Pattern$) + 1 : _
  2000.          StrPos = LEN(Strng$) + 1 : _
  2001.          WasKT = 0 : _
  2002.          GOTO 63286
  2003.       END SUB
  2004. 63300 ' $SUBTITLE: 'BreakFileName - sub to split file name into components'
  2005. ' $PAGE
  2006. '
  2007. '  NAME    -- BreakFileName
  2008. '
  2009. '  INPUTS  -- PARAMETER                    MEANING
  2010. '             FileSpec$        FULL NAME OF FILE
  2011. '             ForJoining       True IF WANT PARTS FORMATTED FOR
  2012. '                                           FORMING FILE NAMES
  2013. '  OUTPUTS -- DrvPath$         DRIVE AND PATH
  2014. '             Prefix$          PREFIX OF FILE NAME
  2015. '             Extension$       EXTENSION OF FILE NAME
  2016. '
  2017. ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH,
  2018. '                              "ARCE"    AS PREFIX OF THE FILE NAME, AND
  2019. '                              "COM"     AS THE EXTENSION OF THE FILE NAME.
  2020. '
  2021. ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM
  2022. '
  2023. '  PURPOSE -- To break a file name into its component parts
  2024. '             of drive/path, prefix, and extension
  2025. '
  2026. '
  2027.       SUB BreakFileName (FileSpec$,DrvPath$,Prefix$,Extension$,ForJoining) STATIC
  2028.       CALL AllCaps (FileSpec$)
  2029.       DrvPath$ = ""
  2030.       Prefix$ = ""
  2031.       Extension$ = ""
  2032.       CALL TrimTrail (FileSpec$,"\")
  2033.       WasL = LEN(FileSpec$)
  2034.       IF WasL < 1 THEN _
  2035.          EXIT SUB
  2036.       CALL FindLast (FileSpec$,"\",WasX,WasY)
  2037.       IF WasX < 1 THEN _
  2038.          IF MID$(FileSpec$,2,1) = ":" THEN _
  2039.             DrvPath$ = LEFT$(FileSpec$,1) : _
  2040.             ZWasS = 3 _
  2041.          ELSE ZWasS = 1 _
  2042.       ELSE DrvPath$ = LEFT$(FileSpec$,WasX-1) : _
  2043.            ZWasS = WasX + 1 : _
  2044.            IF WasY = 1 THEN _
  2045.               DrvPath$ = DrvPath$ + "\"
  2046.       WasX = INSTR(FileSpec$ + ".",".")
  2047.       IF WasX < WasL THEN _
  2048.          Extension$ = MID$(FileSpec$,WasX + 1)
  2049.       IF ZWasS <= WasL THEN _
  2050.          IF WasX >= ZWasS THEN _
  2051.             Prefix$ = MID$(FileSpec$,ZWasS,WasX - ZWasS)
  2052.       IF NOT ForJoining THEN _
  2053.          EXIT SUB
  2054.       IF LEN(DrvPath$) = 1 THEN _
  2055.          IF DrvPath$ <> "\" THEN _
  2056.             DrvPath$ = DrvPath$ + _
  2057.                        ":"
  2058.       IF INSTR(DrvPath$,"\") > 0 AND RIGHT$(DrvPath$,1) <> "\" THEN _
  2059.          DrvPath$ = DrvPath$ + _
  2060.                     "\"
  2061.       IF LEN(Extension$) > 0 THEN _
  2062.          Extension$ = "." + _
  2063.                       Extension$
  2064.       END SUB
  2065. 63310 ' $SUBTITLE: 'RestoreCom - sub to restore comm port'
  2066. ' $PAGE
  2067. '
  2068. '  NAME    -- RestoreCom
  2069. '
  2070. '  INPUTS  -- none
  2071. '
  2072. '  OUTPUTS -- none
  2073. '
  2074. '  PURPOSE -- To restore communications port after an external
  2075. '             program may have left it in altered state
  2076. '
  2077.       SUB RestoreCom STATIC
  2078.       Parity$ = MID$(",N,8,1,E,7,1",7 + 6 * ZEightBit,6)
  2079.       IF ZLocalUser THEN _
  2080.          EXIT SUB
  2081.       CALL SetBaud
  2082.       CALL OpenCom(ZTalkToModemAt$,Parity$)
  2083.       END SUB
  2084. 63320 ' $SUBTITLE: 'ShellExit - sub to shell out from RBBS'
  2085. ' $PAGE
  2086. '
  2087. '  NAME    -- ShellExit
  2088. '
  2089. '  INPUTS  -- ShellTem$     String to invoke shell with
  2090. '
  2091. '  OUTPUTS -- none
  2092. '
  2093. '  PURPOSE -- Delay so that strings can finish printing.  Restore comm
  2094. '             port on return
  2095. '
  2096.       SUB ShellExit (ShellTem$) STATIC
  2097.       CALL DelayTime (8 + ZBPS)
  2098.       CLOSE 3
  2099.       IF NOT ZLocalUser THEN _
  2100.          OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1 : _
  2101.          CLOSE 2
  2102.       CALL MetaGSR (ShellTem$,ZFalse)
  2103.       SHELL ShellTem$
  2104.       CALL DelayTime (2)
  2105.       CALL RestoreCom
  2106.       END SUB
  2107. 63330 ' $SUBTITLE: 'ReadMacro - sub to read macro'
  2108. ' $PAGE
  2109. '
  2110. '  NAME    -- ReadMacro
  2111. '
  2112. '  INPUTS  -- PARAMETER             MEANING
  2113. '
  2114. '  OUTPUTS -- ZOutTxt$               LINE TO PROCESS IN MACRO
  2115. '             ZMacroActive           FLAG WHETHER IN A MACRO
  2116. '
  2117. '  PURPOSE -- Reads in a line from macro file (#6) and processes
  2118. '             macro commands, which are:
  2119. '             *0 - display what follows, no carriage return
  2120. '             *1 - display what follows with carriage return
  2121. '             *B - display block that follows
  2122. '             *F - display File
  2123. '             WT - wait specified # of seconds
  2124. '             >> - append following block to specified file
  2125. '             ST - stack following (with carriage return)
  2126. '             ON - define case
  2127. '             == - case value that applies to following block
  2128. '             M! - execute following macro
  2129. '             M@ - abort macro processing
  2130. '             EY - Echo on (yes)
  2131. '             EN - Echo off (no)
  2132. '             /* - comment line skipped in processing
  2133. '             TK - Turbo key on (if user preference)
  2134. '             << - Read from file into a form
  2135. '             := - Assign value to work variable
  2136. '
  2137.       SUB ReadMacro STATIC
  2138.       IF ZMacroTemplate$ <> "" THEN _
  2139.          GOTO 63392
  2140.       IF ZDistantTGet = 2 THEN _
  2141.          GOTO 63349
  2142. 63336 GOSUB 63395
  2143.       IF NOT ZMacroActive THEN _
  2144.          ZMacroEcho = ZTrue : _
  2145.          EXIT SUB
  2146.       IF LEN(ZOutTxt$) < 3 THEN _
  2147.          GOTO 63398
  2148.       WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3)
  2149.       IF CompareVar > 0 THEN _
  2150.          IF NOT CaseExecute THEN _
  2151.             IF LEFT$(ZOutTxt$,3) = ZSmartTextCode$+"==" THEN _
  2152.                GOTO 63370 _
  2153.             ELSE IF LEFT$(ZOutTxt$,7) = ZSmartTextCode$ + "END ON" THEN _
  2154.                     CompareVar = 0 : _
  2155.                     GOTO 63336 _
  2156.                   ELSE GOTO 63336
  2157.       IF LEFT$(ZOutTxt$,1) <> ZSmartTextCode$ THEN _
  2158.          GOTO 63398
  2159.       CALL CheckInt (MID$(ZOutTxt$,2))
  2160.       IF ZErrCode > 0 THEN _
  2161.          GOTO 63398
  2162.       IF ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _
  2163.          ZOutTxt$ = WasX$ : _  ' Macro command ask
  2164.          ZForceKeyboard = ZTrue : _
  2165.          ZMacroSave = ZTestedIntValue : _
  2166.          ZLinesPrinted = 1 : _
  2167.          ZNonStop = (ZPageLength < 1) : _
  2168.          EXIT SUB
  2169.       ON (1+INSTR("*0*1*B*FWT>>STON==M!M@EYEN/*TK<<:=LVNVCVLO",MID$(ZOutTxt$,2,2)))\2 GOTO _
  2170.          63345, _  ' Display with no Carriage Return
  2171.          63347, _  ' Display with Carriage Return
  2172.          63340, _  ' Display Block
  2173.          63348, _  ' Display File
  2174.          63343, _  ' Wait # of seconds
  2175.          63350, _  ' Append to file
  2176.          63355, _  ' Stack
  2177.          63360, _  ' Case
  2178.          63370, _  ' Case Comparison
  2179.          63375, _  ' Macro execute
  2180.          63380, _  ' Macro Abort
  2181.          63383, _  ' Macro Echo on
  2182.          63385, _  ' Macro Echo off
  2183.          63336, _  ' Macro Comment
  2184.          63387, _  ' Turbo Key allowed
  2185.          63390, _  ' Form read
  2186.          63362, _  ' Assign value to work var
  2187.          63363, _  ' LV list verify
  2188.          63364, _  ' NV number verify
  2189.          63364, _  ' CV character verify
  2190.          63367     ' LO assign file location
  2191.       GOTO 63398
  2192. 63338 ZOutTxt$ = WasX$
  2193. 63339 ZSubParm = 4
  2194.       CALL TPut
  2195.       RETURN
  2196. 63340 WasX$ = ZSmartTextCode$ + "END"  ' Print Block
  2197.       GOSUB 63395
  2198.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2199.          GOSUB 63339
  2200.          CALL SkipLine (1)
  2201.          GOSUB 63395
  2202.       WEND
  2203.       GOTO 63336
  2204. 63343 CALL CheckInt (WasX$)      ' Delay
  2205.       IF ZErrCode = 0 THEN _
  2206.          CALL DelayTime (ZTestedIntValue)
  2207.       GOTO 63336
  2208. 63345 GOSUB 63338               ' Print Line
  2209.       GOTO 63336
  2210. 63347 GOSUB 63338
  2211.       CALL SkipLine (1)
  2212.       GOTO 63336
  2213. 63348 CALL Trim (WasX$)            ' Print File
  2214.       CALL FINDITX (WasX$,7)
  2215.       IF NOT ZOK THEN _
  2216.          GOTO 63336
  2217.       ZLinesPrinted = 1
  2218.       ZNo = ZFalse
  2219.       ZNonStop = (ZNonStop OR ZPageLength < 1)
  2220. 63349 WHILE (NOT EOF(7) AND (NOT ZNo) AND (ZNonStop OR (ZLinesPrinted < ZPageLength)) AND (ZSubParm > -1))
  2221.          CALL ReadDir (7,1)
  2222.          GOSUB 63396
  2223.          ZSubParm = 5
  2224.          CALL TPut
  2225.       WEND
  2226.       ZDistantTGet = 0
  2227.       IF ZSubParm < 0 THEN _
  2228.          EXIT SUB
  2229.       IF EOF(7) OR ZNo THEN _
  2230.          CLOSE 7 : _
  2231.          ZNo = ZFalse : _
  2232.          GOTO 63336
  2233.       ZDistantTGet = 2
  2234.       CALL PauseExit
  2235.       EXIT SUB
  2236. 63350 ZWasEN$ = WasX$            ' Append to file
  2237.       WasX = INSTR(ZWasEN$," /FL")
  2238.       OverStrike = (WasX > 0)
  2239.       IF OverStrike THEN _
  2240.          ZWasEN$ = LEFT$(ZWasEN$,WasX-1) + RIGHT$(ZWasEN$,LEN(ZWasEN$)-WasX-3)
  2241.       CALL Trim (ZWasEN$)
  2242.       CALL LockAppend
  2243.       IF ZErrCode > 0 THEN _
  2244.          GOTO 63352
  2245.       GOSUB 63395
  2246.       WasX$ = ZSmartTextCode$ + "END"
  2247.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2248.          CALL PrintWorkA (ZOutTxt$)
  2249.          GOSUB 63395
  2250.       WEND
  2251. 63352 CALL UnLockAppend
  2252.       OverStrike = ZFalse
  2253.       GOTO 63336
  2254. 63355 ZCommPortStack$ = ZCommPortStack$ + WasX$ + ZCarriageReturn$  ' STack
  2255.       GOTO 63336
  2256. 63360 CompareVar = VAL(WasX$)
  2257.       CALL AllCaps (WasX$)
  2258.       IF CompareVar < 1 OR CompareVar > ZMaxWorkVar THEN _
  2259.          CompareVar = 0
  2260.       GOTO 63336
  2261. 63362 CALL Trim (WasX$)
  2262.       CALL CheckInt (WasX$)
  2263.       WasX = INSTR(WasX$," ")
  2264.       IF WasX > 0 AND ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _
  2265.          ZGSRAra$(ZTestedIntValue) = RIGHT$(WasX$,LEN(WasX$)-WasX)
  2266.       GOTO 63336
  2267. 63363 ZVerifyList$ = WasX$
  2268.       CALL Trim (ZVerifyList$)
  2269.       GOTO 63365
  2270. 63364 CALL Trim (WasX$)
  2271.       WasX = INSTR(WasX$," ")
  2272.       IF WasX = 0 THEN _
  2273.          GOTO 63336
  2274.       ZVerifyLow$ = LEFT$(WasX$,WasX-1)
  2275.       ZVerifyHigh$ = RIGHT$(WasX$,LEN(WasX$)-WasX)
  2276.       CALL Trim (ZVerifyLow$)
  2277.       CALL Trim (ZVerifyHigh$)
  2278.       ZVerifyNumeric = (MID$(ZOutTxt$,2,1) = "N")
  2279. 63365 ZVerifying = ZTrue
  2280.       GOTO 63336
  2281. 63367 CALL TRIM (WasX$)
  2282.       ZFileLocation$ = WasX$
  2283.       GOTO 63336
  2284. 63370 IF CompareVar = 0 THEN _     ' Compare Case
  2285.          GOTO 63336
  2286.       ZWasDF$ = ZGSRAra$(CompareVar)
  2287.       CALL AllCaps (ZWasDF$)
  2288.       CaseExecute = (WasX$ = ZWasDF$)
  2289.       GOTO 63336
  2290. 63375 CALL Trim (WasX$)           ' Execute Macro
  2291.       CALL Macro (WasX$,WasX)
  2292.       GOTO 63336
  2293. 63380 ZMacroActive = ZFalse     ' Abort Macro
  2294.       GOTO 63398
  2295. 63383 ZMacroEcho = ZTrue
  2296.       GOTO 63336
  2297. 63385 ZMacroEcho = ZFalse
  2298.       GOTO 63336
  2299. 63387 ZTurboKey = -ZTurboKeyUser   'TK Turbo Key
  2300.       GOTO 63336
  2301. 63390 ZUserIn$ = ZOutTxt$
  2302.       ZUserIn$(5) = ""
  2303.       ZUserIn$(6) = ""
  2304.       ZWasQ = 1
  2305.       ZStoreParseAt = 1
  2306.       CALL ParseIt
  2307.       IF ZWasQ < 4 THEN _
  2308.          GOTO 63336
  2309.       WasX$ = ZSmartTextCode$ + "END"
  2310.       GOSUB 63397
  2311.       ZMacroTemplate$ = ""
  2312.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2313.          ZMacroTemplate$ = ZMacroTemplate$ + ZOutTxt$ + ZCrLf$
  2314.          GOSUB 63397
  2315.       WEND
  2316.       WasX = VAL(ZUserIn$(4))
  2317.       VarLen = (ZUserIn$(3) <> "/F")
  2318.       CALL FindIt (ZUserIn$(2))
  2319.       IF (WasX < 1) OR (NOT ZOK) OR (VarLen AND WasX > ZMaxWorkVar) THEN _
  2320.          ZMacroTemplate$ = "" : _
  2321.          GOTO 63336
  2322.       PauseEachRec = (ZUserIn$(6) = "/1")
  2323. 63392 CALL FormRead (ZMacroTemplate$,ZUserIn$(2),NOT VarLen,WasX,(ZUserIn$(5) = "/FL"),PauseEachRec)
  2324.       IF ZMacroTemplate$ <> "" THEN _
  2325.          EXIT SUB _
  2326.       ELSE GOTO 63336
  2327. 63395 GOSUB 63397
  2328.       GOSUB 63396
  2329.       RETURN
  2330. 63396 CALL SmartText (ZOutTxt$,ZFalse, OverStrike)
  2331.       CALL MetaGSR (ZOutTxt$,OverStrike)
  2332.       RETURN
  2333. 63397 IF EOF(6) THEN _         ' Read next line in macro
  2334.          ZMacroActive = ZFalse _
  2335.       ELSE CALL ReadDir (6,1) : _
  2336.            ZMacroActive = (ZErrCode = 0)
  2337.       RETURN
  2338. 63398 END SUB    ' Not Macro command - pass to normal processing
  2339. 63400 ' $SUBTITLE: 'LockAppend - prepares for file append'
  2340. ' $PAGE
  2341. '
  2342. '  NAME    -- LockAppend
  2343. '
  2344. '  INPUTS  -- ZWasEN$            Name of file to append to
  2345. '
  2346. '  OUTPUTS -- none
  2347. '
  2348. '  PURPOSE -- Locks and opens file to append to
  2349. '
  2350.       SUB LockAppend STATIC
  2351.       WasBX = &H4
  2352.       ZSubParm = 9
  2353.       CALL FileLock
  2354.       ZErrCode = 0
  2355.       CALL OpenWorkA (ZWasEN$)
  2356.       END SUB
  2357. 63410 ' $SUBTITLE: 'UnLockAppend - cleans up after file append'
  2358. ' $PAGE
  2359. '
  2360. '  NAME    -- UnLockAppend
  2361. '
  2362. '  INPUTS  -- none
  2363. '
  2364. '  OUTPUTS -- none
  2365. '
  2366. '  PURPOSE -- Unlocks and close file appending to
  2367. '
  2368.       SUB UnLockAppend STATIC
  2369.       WasBX = &H4
  2370.       ZSubParm = 10
  2371.       CALL FileLock
  2372.       CLOSE 2
  2373.       END SUB
  2374. 63420 ' $SUBTITLE: 'FormRead - Reads from a file into a form'
  2375. ' $PAGE
  2376. '
  2377. '  NAME    -- FormRead
  2378. '
  2379. '  INPUTS  -- Template$      Display formvoke shell with
  2380. '             FilName$       Data file to get values from
  2381. '             FixedLength    Whether file is fixed length
  2382. '             DataVar       # bytes data if fixed length; # fields
  2383. '                              if variable length
  2384. '             OverStrike     Whether typeover into form or insert
  2385. '             RecPause      Whether pause after every record displayed
  2386. '                               otherwise when screen fills
  2387. '  OUTPUTS -- (displays data base records)
  2388. '
  2389. '  PURPOSE -- Allows field oriented data base data to be displayed
  2390. '               in a human readable format by substituting field
  2391. '               data into template or form
  2392. '
  2393.       SUB FormRead (Template$,FilName$,FixedLength,DataVar,OverStrike,RecPause) STATIC
  2394. 63422 IF EOF(2) OR ZNo OR (ZErrCode > 0) OR (ZSubParm < 0) THEN _
  2395.          Template$ = "" : _
  2396.          EXIT SUB
  2397.       IF FixedLength THEN _
  2398.          CALL ReadDir (2,1) : _
  2399.          ZGSRAra$(1) = ZOutTxt$ _
  2400.       ELSE CALL ReadParms (ZGSRAra$(),DataVar,1)
  2401.       WasX$ = Template$
  2402.       CALL SmartText (WasX$,ZTrue,OverStrike)
  2403.       CALL MetaGSR (WasX$,OverStrike)
  2404.       CALL BufAsUnit (WasX$)
  2405.       IF RecPause OR (ZPageLength > 0 AND (ZLinesPrinted >= ZPageLength-1)) THEN _
  2406.          CALL PauseExit : _
  2407.          EXIT SUB
  2408.       GOTO 63422
  2409.       END SUB
  2410. 63440 ' $SUBTITLE: 'BufAsUnit - prints string with no pauses'
  2411. ' $PAGE
  2412. '
  2413. '  NAME    -- BufAsUnit
  2414. '
  2415. '  INPUTS  -- Strng$     String to print
  2416. '
  2417. '  OUTPUTS -- none
  2418. '
  2419. '  PURPOSE -- Prints string with embedded carriage returns.
  2420. '             Will never pause.  Used to print when can't call TGet
  2421. '
  2422.       SUB BufAsUnit (Strng$) STATIC
  2423.       WasL = LEN(Strng$)
  2424.       IF WasL < 1 THEN _
  2425.          EXIT SUB
  2426.       StartByte = 1
  2427. 63450 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$)
  2428.       IF CRat > 0 AND CRat < WasL THEN _
  2429.          CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _
  2430.       ELSE CRFound = ZFalse
  2431.       EOLlen = -2 * CRFound
  2432.       IF CRFound THEN _
  2433.          EOD = CRat _
  2434.       ELSE EOD = WasL + 1
  2435.       NumBytes = EOD - StartByte
  2436.       ZOutTxt$ = MID$(Strng$,StartByte,NumBytes)
  2437.       ZSubParm = 4
  2438.       CALL TPut
  2439.       CALL SkipLine (-(CRFound))
  2440.       IF ZRet THEN _
  2441.          EXIT SUB
  2442.       StartByte = EOD + EOLlen
  2443.       IF StartByte <= WasL THEN _
  2444.          GOTO 63450
  2445.       END SUB
  2446. 63460 ' Check if macro exists and execute if does
  2447.       SUB MacroExe (Strng$) STATIC
  2448.       CALL Trim (Strng$)
  2449.       CALL Macro (Strng$,Found)
  2450.       IF NOT Found THEN _
  2451.          EXIT SUB
  2452.       CALL FdMacExe
  2453.       END SUB
  2454. 63462 ' Unconditionally executes a macro
  2455.       SUB FdMaCExe STATIC
  2456.       ZOutTxt$ = ""
  2457.       ZMacroEcho = ZFalse
  2458.       ZSubParm = 1
  2459.       CALL TGet
  2460.       END SUB
  2461. 63465 ' Forces a keyboard pause inside a macro
  2462.       SUB PauseExit STATIC
  2463.       ZSubParm = 4
  2464.       ZTurboKey = -ZTurboKeyUser
  2465.       ZOutTxt$ = ZMorePrompt$ + ">" + MID$("? ! ",2*ZTurboKey+1,2)
  2466.       ZForceKeyboard = ZTrue
  2467.       ZNoAdvance = ZTrue
  2468.       CALL TPut
  2469.       ZLinesPrinted = 0
  2470.       ZUserIn$ = ""
  2471.       END SUB
  2472. 63470 ' $SUBTITLE: 'SetPrompt - sub to set prompts based on user security'
  2473. ' $PAGE
  2474. '
  2475. '  NAME    -- SetPrompt
  2476. '
  2477. '  INPUTS  -- PARAMETER           MEANING
  2478. '             ZBegMain          POSITION START OF MAIN CMDS
  2479. '             ZBegFile          POSITION START OF FILE CMDS
  2480. '             ZBegUtil          POSITION START OF UTIL CMDS
  2481. '             ZBegLibrary       POSITION START OF Library CMDS
  2482. '
  2483. '  OUTPUTS -- PRESENT.OPTS$         DISPLAY WHAT USER CAN DO (1st)
  2484. '             CALLERS.OPTS$         DISPLAY WHAT USER CAN DO (2nd)
  2485. '             ZMainOpts$            MAIN OPTS USER CAN DO
  2486. '             ZFileOpts$            FILE OPTS USER CAN DO
  2487. '             ZUtilOpts$            UTIL OPTS USER CAN DO
  2488. '             ZLibOpts$         Library OPTS USER CAN DO
  2489. '
  2490. '  PURPOSE -- Sets command line display of what user can do by
  2491. '             section and display of what all user can do
  2492. '
  2493.       SUB SetPrompt STATIC
  2494.       First = ZBegMain
  2495.       Last = ZBegFile - 1
  2496.       CALL SetOpts (ZMainOpts$,ZInvalidMainOpts$,First,Last)
  2497.       First = ZBegFile
  2498.       Last = ZBegUtil - 1
  2499.       CALL SetOpts (ZFileOpts$,ZInvalidFileOpts$,First,Last)
  2500.       First = ZBegUtil
  2501.       Last = ZBegLibrary - 1
  2502.       CALL SetOpts (ZUtilOpts$,ZInvalidUtilOpts$,First,Last)
  2503.       First = ZBegLibrary
  2504.       Last = ZBegLibrary + 6
  2505.       CALL SetOpts (ZLibOpts$,ZInvalidLibraryOpts$,First,Last)
  2506.       First = 50
  2507.       Last = 56
  2508.       CALL SetOpts (SysOpt$,ZInvalidSysOpts$,First,Last)
  2509.       First = 46
  2510.       Last = 49
  2511.       CALL SetOpts (GlobalOpts$,InvalidGlobalOpts$,First,Last)
  2512.       IF LEN(SysOpt$) > 0 THEN _
  2513.          ZSystemOpts$ = "Sysop: " + _
  2514.                         SysOpt$
  2515.       ZMainOpts$ = GlobalOpts$ + _
  2516.                    ZMainOpts$
  2517.       ZFileOpts$ = GlobalOpts$ + _
  2518.                    ZFileOpts$
  2519.       ZUtilOpts$ = GlobalOpts$ + _
  2520.                    ZUtilOpts$
  2521.       ZLibOpts$ = GlobalOpts$ + _
  2522.                       ZLibOpts$
  2523.       CALL SortString (SysOpt$)
  2524.       CALL SortString (ZMainOpts$)
  2525.       ZMainOpts$ = ZMainOpts$ + _
  2526.                    SysOpt$
  2527.       CALL SortString (ZFileOpts$)
  2528.       CALL SortString (ZUtilOpts$)
  2529.       CALL SortString (ZLibOpts$)
  2530.       CALL AddCommas (ZMainOpts$)
  2531.       CALL AddCommas (ZFileOpts$)
  2532.       CALL AddCommas (ZUtilOpts$)
  2533.       CALL AddCommas (ZLibOpts$)
  2534.       ZDirPrompt$ = "Which category(ies) (" + _                 ' Bh
  2535.         MID$("A for all, L to list them or [RETURN] to quit)",8 * (ZUserSecLevel => ZMinSecToView) + 9)  ' Bh
  2536.       ZQuitPromptExpert$ = "Quit C,S, or to F,[M],U,@"
  2537.       ZQuitPromptNovice$ = "Quit C)onference, S)ession or to section " + _
  2538.                             "F)ile, [M]ain, U)til or @)Library"
  2539.       ZQuitList$ = "FMUS@C"
  2540.       IF ZUserSecLevel < ZOptSec(18) THEN _
  2541.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,23) : _
  2542.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,61) : _
  2543.          MID$(ZQuitList$,5) = " "
  2544.       IF ZUserSecLevel < ZOptSec(15) THEN _
  2545.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,22) + _
  2546.                                MID$(ZQuitPromptExpert$,25) : _
  2547.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,56) + _
  2548.                                MID$(ZQuitPromptNovice$,63) : _
  2549.          MID$(ZQuitList$,3,1) = " "
  2550.       IF ZUserSecLevel < ZOptSec(6) THEN _
  2551.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,16) + _
  2552.                                MID$(ZQuitPromptExpert$,19) : _
  2553.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,41) + _
  2554.                                MID$(ZQuitPromptNovice$,49) : _
  2555.          MID$(ZQuitList$,1,1) = " "
  2556.       CALL SetSection
  2557.       END SUB
  2558. 63480 ' $SUBTITLE: 'NoPath - detects whether string has path'
  2559. ' $PAGE
  2560. '
  2561. '  NAME    -- NoPath
  2562. '
  2563. '  INPUTS  -- Strng$     String to check
  2564. '
  2565. '  OUTPUTS -- HAS.NONE   True if has no path
  2566. '
  2567. '  PURPOSE -- Detects whether have path.  Used when shouldn't
  2568. '             be any
  2569. '
  2570.       SUB NoPath (Strng$,HasPath) STATIC
  2571.       CALL BreakFileName (Strng$,DrvPath$,Prefix$,Ext$,ZFalse)
  2572.       HasPath = (DrvPath$ <> "")
  2573.       END SUB
  2574. 63490 ' $SUBTITLE: 'FindIt - Determine whether file exists'
  2575. ' $PAGE
  2576. '
  2577. '  NAME    -- FindIt
  2578. '
  2579. '  INPUTS  -- FilName$   File name to check
  2580. '
  2581. '  OUTPUTS -- ZOK         True if file exists.  Opened as #2 if does
  2582. '
  2583. '  PURPOSE -- Determine whether file exists and open as standard work
  2584. '             file if it does (#2)
  2585. '
  2586.       SUB FindIt (FilName$) STATIC
  2587.       CALL FindItX (FilName$,2)
  2588.       END SUB
  2589. 63495 ' $SUBTITLE: 'TimeBack - Give time back to the user'
  2590. ' $PAGE
  2591. '
  2592. '  NAME    -- TimeBack
  2593. '
  2594. '  INPUTS  -- Index    = 1    Set start of time (begin give back)
  2595. '                      = 2    Give back time from defined start
  2596. '
  2597. '  OUTPUTS -- ZTimeCredits!         Number of seconds to credit with
  2598. '             ZSecsPerSession!  Number of seconds in current session
  2599. '
  2600. '  PURPOSE -- Give time back to the user (e.g. sysop initiated chat)
  2601. '
  2602.       SUB TimeBack (Index) STATIC
  2603.       IF Index = 1 THEN _
  2604.          CALL TimeRemain (MinsRemaining) : _
  2605.          ZWasQ! = ZSecsUsedSession! : _
  2606.          EXIT SUB
  2607.       CALL TimeRemain (MinsRemaining)
  2608.       WasX! = (ZSecsUsedSession! - ZWasQ!)
  2609.       ZTimeCredits! = ZTimeCredits! + WasX!
  2610.       END SUB
  2611. 63500 ' $SUBTITLE: 'CmdStackPushPop - Save/restore command stack'
  2612. ' $PAGE
  2613. '
  2614. '  NAME    -- CmdStackPushPop
  2615. '
  2616. '  INPUTS  -- Index    = 1    Save command stack
  2617. '                      = 2    Restore command stack
  2618. '             ZAnsIndex
  2619. '             ZLastIndex
  2620. '             ZUserIn$()
  2621. '
  2622. '  OUTPUTS -- ZUserIn$()                  Stacked commands
  2623. '             ZAnsIndex
  2624. '             ZLastIndex
  2625. '
  2626. '  PURPOSE -- Save restore a command stack list when need to input
  2627. '             another list in middle of previous list processing
  2628. '
  2629.       SUB CmdStackPushPop (Index) STATIC
  2630.       IF Index = 1 THEN _
  2631.          OrigLastIndex = ZLastIndex : _  ' save
  2632.          OrigIndex = ZAnsIndex : _
  2633.          FOR WasI = 1 TO OrigLastIndex : _
  2634.              ZOutTxt$(WasI) = ZUserIn$(WasI) : _
  2635.          NEXT : _
  2636.          EXIT SUB
  2637.       ZLastIndex = OrigLastIndex        ' restore
  2638.       ZAnsIndex = OrigIndex
  2639.       FOR WasI = 1 TO OrigLastIndex
  2640.          ZUserIn$(WasI) = ZOutTxt$(WasI)
  2641.       NEXT
  2642.       END SUB
  2643. 63510 ' $SUBTITLE: 'VerifyAns - edits an answer'
  2644. ' $PAGE
  2645. '
  2646. '  NAME    -- VerifyAns
  2647. '                                  MEANING
  2648. '  INPUTS  -- ZVerifying      Whether verifying
  2649. '             ZUserIn$(1)     Response verifying
  2650. '             ZVerifyList$    List of appropriate answers.  1st
  2651. '                                char is what separates answers
  2652. '             ZVerifyNumeric     Verify that is a valid integer
  2653. '                                  if false, then verifying that
  2654. '                                  a string is between 2 values
  2655. '             ZVerifyLow$     Lowest ok value of string
  2656. '             ZVerifyHigh$    Highest ok value of string
  2657. '
  2658. '  OUTPUTS -- ZOK             Whether passes verification
  2659. '             ZVerifyList$    Empties if ok
  2660. '             ZVerifying      Sets false if ok
  2661. '             ZVerifyNumeric  Sets false if ok
  2662. '
  2663. '  PURPOSE -- Processes edits on a user input
  2664. '
  2665.       SUB VerifyAns STATIC
  2666.       ZOK = ZTrue
  2667.       IF NOT ZVerifying THEN _
  2668.          EXIT SUB
  2669.       Temp$ = ZUserIn$(1)
  2670.       CALL AllCaps (Temp$)
  2671.       IF ZVerifyList$ <> "" THEN _
  2672.          WasX$ = LEFT$(ZVerifyList$,1) : _
  2673.          ZOK = (INSTR (ZVerifyList$, WasX$+Temp$+WasX$) > 0) _
  2674.       ELSE IF ZVerifyNumeric THEN _
  2675.               CALL CheckInt (ZUserIn$) : _
  2676.               ZOK = (ZErrCode = 0 AND _
  2677.                     ZTestedIntValue >= VAL(ZVerifyLow$) AND _
  2678.                     ZTestedIntValue <= VAL(ZVerifyHigh$)) _
  2679.            ELSE ZOK = (Temp$ >= ZVerifyLow$ AND Temp$ <= ZVerifyHigh$)
  2680.       IF ZOK THEN _
  2681.          ZVerifyList$ = "" : _
  2682.          ZVerifying = ZFalse : _
  2683.          ZVerifyNumeric = ZFalse
  2684.       END SUB
  2685. 63520 ' $SUBTITLE: 'BinSearch - binary search a file'
  2686. ' $PAGE
  2687. '
  2688. '  NAME    -- BinSearch
  2689. '                                  MEANING
  2690. '  INPUTS  -- PassedSearchFor$  Value you are looking for
  2691. '             StartPos          Starting position of sort key
  2692. '             NumChars          # of characters in sort key
  2693. '             LenRec            Length of record of data file searching
  2694. '             High              Record # of last record
  2695. '             ZFastTabs$        In a binary integer subfield (2 bytes)
  2696. '                                  holds 1st record when might find
  2697. '                                  a key beginning with a particular
  2698. '                                  character (0-9,A-Z).   Empty if
  2699. '                                  no Fast Tab exists for the file.
  2700. '
  2701. '  OUTPUTS -- RecFoundAt        Record # value found at (0 if none)
  2702. '             RecFound$         Full data record when found
  2703. '
  2704. '  PURPOSE -- Binary searches work file #2 for a key value in a
  2705. '             data file that is sorted on a key field
  2706. '
  2707.       SUB BinSearch (PassedSearchFor$,StartPos, NumChars, LenRec, High, RecFoundAt, RecFound$) STATIC
  2708.       SearchFor$ = LEFT$(PassedSearchFor$,NumChars)
  2709.       SearchFor$ = SearchFor$ + SPACE$(NumChars-LEN(SearchFor$))
  2710.       FIELD #2, LenRec AS SearchRec$
  2711.       Low = 0
  2712.       IF LEN(ZFastTabs$) < 72 THEN _
  2713.          GOTO 63522
  2714.       WasX$ = LEFT$(SearchFor$,1)
  2715.       WasX = INSTR("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",WasX$)
  2716.       IF WasX > 0 THEN _
  2717.          Low = CVI(MID$(ZFastTabs$,1+2*(WasX-1),2)) - 1
  2718.       IF WasX < 36 THEN _
  2719.          High = CVI(MID$(ZFastTabs$,1+2*WasX,2))
  2720. 63522 RecFoundAt = 0
  2721.       WasX$ = SPACE$ (NumChars)
  2722.       Done = ZFalse
  2723.       WHILE NOT Done
  2724.          WasI = INT(((High + Low) / 2) + .5)
  2725.          GET 2, WasI
  2726.          LSET WasX$ = MID$(SearchRec$, StartPos, NumChars)
  2727.          IF WasX$ = SearchFor$ THEN _
  2728.             RecFound$ = SearchRec$: _
  2729.             RecFoundAt = WasI : _
  2730.             Done = ZTrue _
  2731.          ELSE IF (High - Low) < 2 THEN _
  2732.                  Done = ZTrue _
  2733.               ELSE IF WasX$ < SearchFor$ THEN _
  2734.                       Low = WasI _
  2735.                    ELSE IF WasX$ > SearchFor$ THEN _
  2736.                            High = WasI
  2737.       WEND
  2738.       END SUB
  2739. 63530 ' Take modem offhook
  2740.       SUB TakeOffHook STATIC
  2741.       CALL ModemPut (ZModemGoOffHookCmd$)
  2742.       CALL DelayTime (3)
  2743.       END SUB
  2744. 63540 ' Match Name to one in message file
  2745.       SUB MsgNameMatch (PrimeName$,AltName$,SearchPos,Found) STATIC
  2746.       WasX$ = LEFT$(PrimeName$+"  ",22-8*(SearchPos < 7))
  2747.       Found = (MID$(ZMsgRec$,SearchPos, LEN(WasX$)) = WasX$)
  2748.       IF NOT Found THEN _
  2749.          IF AltName$ <> "" THEN _
  2750.             WasX$ = LEFT$(AltName$ + "  ",22-8*(SearchPos < 7)) : _
  2751.             Found = (MID$(ZMsgRec$,SearchPos, LEN(WasX$)) = WasX$)
  2752.       END SUB
  2753. '
  2754. ' CHat Mods begin here
  2755. '
  2756. '63550 ' $SUBTITLE: 'LOG.NEW.FOR.CHAT - Save user info for chat'
  2757. ' $PAGE
  2758. '
  2759. '  NAME    -- LOG.NEW.FOR.CHAT
  2760. '
  2761. '  INPUTS  -- NODES.IN.SYSTEM
  2762. '
  2763. '  OUTPUTS -- Updates the node record in RBBSCHAT.DEF with this users
  2764. '             name and chat activity (always "I") when the user logs on.
  2765. '
  2766. '  PURPOSE -- See above OUTPUTS
  2767. '
  2768. '      SUB LogNewForChat(NodesInSystem) STATIC
  2769. '      FileName$ = "RBBSCHAT.DEF"
  2770. '      CALL FindItX (FileName$, 7)
  2771. '      REM ** IF "RBBSCHAT.DEF" DOES NOT EXIST, THEN CREATE IT **
  2772. '      IF NOT ZOK THEN
  2773. '         CALL OpenWrk7 (FileName$)
  2774. '         FIELD 7, 128 AS TempNode$
  2775. '         LSET TempNode$ = SPACE$(128)
  2776. '         FOR Index = 1 TO ZMaxNodes
  2777. '            CALL LockIt7 (Index, ZFalse)
  2778. '         NEXT
  2779. '      END IF
  2780. '      ChatIndex = ZNodeRecIndex - 1
  2781. '      CLOSE 7
  2782. '      CALL OpenWrk7 (FileName$)
  2783. '      FIELD 7, 1 AS ChatActivity$, _
  2784. '               2 AS PagingNode$,   _
  2785. '               2 AS PrivateFor$,   _
  2786. '              72 AS ChatInput$,    _
  2787. '              31 AS ChatName$,     _
  2788. '               1 AS InTrueChat$
  2789. '      CALL LockIt7 (ChatIndex, ZTrue)
  2790. '      LSET ChatActivity$ = "I"    ' I means inactive
  2791. '      LSET PagingNode$ = MKI$(0)
  2792. '      LSET ChatName$ = SPACE$(31)
  2793. '      IF ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ THEN
  2794. '         LSET ChatName$ = "SYSOP"
  2795. '       ELSE
  2796. '         LSET ChatName$ = ZActiveUserName$
  2797. '      END IF
  2798. '      LSET ChatInput$ = SPACE$(72)
  2799. '      LSET PrivateFor$ = MKI$(0)
  2800. '      LSET InTrueChat$ = "I"
  2801. '      CALL LockIt7 (ChatIndex, ZFalse)
  2802. '      CLOSE 7
  2803. '      END SUB
  2804.  
  2805. '63560 ' $SUBTITLE: 'CBCHECK - Check for a page attempt'
  2806. ' $PAGE
  2807. '
  2808. '  NAME    -- CBCHECK
  2809. '
  2810. '  INPUTS  -- NONE
  2811. '
  2812. '  OUTPUTS -- ChatActivity$   Changed to reflect whether or not they
  2813. '                              are going to chat
  2814. '
  2815. '  PURPOSE -- Check to see if we have been paged from another node
  2816. '
  2817. '      SUB CBCHECK STATIC
  2818. '      ZOutTxt$ = ""
  2819. '      DoTrueChat = ZFalse
  2820. '      FileName$ = "RBBSCHAT.DEF"
  2821. '      CALL FindItX (FileName$, 7)
  2822. '      IF ZOK THEN
  2823. '         ChatIndex = ZNodeRecIndex - 1
  2824. '         CLOSE 7
  2825. '         CALL OpenWrk7 (FileName$)
  2826. '         FIELD 7, 1 AS ChatActivity$, _
  2827. '                  2 AS PagingNode$,   _
  2828. '                  2 AS PrivateFor$,   _
  2829. '                 72 AS ChatInput$,    _
  2830. '                 31 AS ChatName$,     _
  2831. '                  1 AS InTrueChat$
  2832. '         CALL LockIt7 (ChatIndex, ZTrue)
  2833. '         IF ChatActivity$ = "R" THEN   'R means request for chat
  2834. '            PagerIndex = CVI(PagingNode$)
  2835. '            CALL RingCaller
  2836. '            CALL LockIt7 (PagerIndex, ZTrue)
  2837. '            ZOutTxt$ = ChatName$
  2838. '            DoTrueChat = (InTrueChat$ = "A")
  2839. '            CALL TrimTrail (ZOutTxt$, " ")
  2840. '            CALL QuickTPut( ZOutTxt$ + " is requesting that you join the CB simulator!", 1)
  2841. '            ZOutTxt$ = "Do you plan to join the CB simulator (Y/[N])"
  2842. '            ZSubParm = 1
  2843. '            CALL TGet
  2844. '            CALL LockIt7 (ChatIndex, ZTrue)
  2845. '            IF ZNo OR (ZWasQ = 0) THEN
  2846. '               LSET ChatActivity$ = "N"   'NO I WON'T BE CHATTING
  2847. '             ELSE
  2848. '               LSET ChatActivity$ = "Y"   'YEAH I'LL BE CHATTING
  2849. '               CALL QuickTPut("Use the C)hat Command to enter Chat", 2)
  2850. '            END IF
  2851. '            IF DoTrueChat THEN
  2852. '               LSET InTrueChat$ = "Y"
  2853. '             ELSE
  2854. '               LSET InTrueChat$ = "I"
  2855. '            END IF
  2856. '            CALL LockIt7 (ChatIndex, ZFalse)
  2857. '            CALL UpdtCalr("Paged from CB sim by node" + STR$(PagerIndex), 1)
  2858. '         END IF
  2859. '         CLOSE 7
  2860. '      END IF
  2861. '      END SUB
  2862.  
  2863. '63570 ' $SUBTITLE: 'CBCHAT - This is the actual chat code'
  2864. ' $PAGE
  2865. '
  2866. '  NAME    -- CBCHAT
  2867. '
  2868. '  INPUTS  -- NODES.IN.SYSTEM
  2869. '
  2870. '  INTERNAL - NodesToSquelch$     STRING OF NODES NOT TO RECEIVE TEXT FROM
  2871. '             HasPaged             NODE (IF ANY) THAT THIS USER PAGED
  2872. '             CurrentNodeIndex    NODE RECORD IN "RBBSCHAT.DEF"
  2873. '             ChatActivity$        CURRENT STATUS OF EACH NODE   (RBBSCHAT.DEF)
  2874. '             PagingNode$          NODE WHICH HAS PAGED THIS ONE (RBBSCHAT.DEF)
  2875. '             PrivateFor$          THIS IS TURNED ON FOR PRIVATE MSG
  2876. '             ChatInput$           CURRENT TEXT INPUT BY USER FOR CHATTING
  2877. '             ChatName$            NAME OF USER ON EACH NODE (NOT ALWAYS USED)
  2878. '             SquelchIt            BOOLEAN - MEANS NODE IS IGNORED
  2879. '             ZOutTxt$(0)                 THIS IS TEXT TYPED BY -THIS- NODE
  2880. '             ZUserIn$()                  USED TO SAVE CURRENT STATUS OF EACH NODE
  2881. '                                   THIS INFO IS LATER COMPARED, AND IF THAT
  2882. '                                   STATUS IS CHANGED, THEN THE USER IS NOTIFIED
  2883. '             ChatHold$()          USED TO SAVE CURRENT TEXT INPUT BY EACH USER
  2884. '             DoTrueChat          MEANS OTHER USER HAS PAGED FROM TRUECH@
  2885. '                                   MODE, SO CBCHAT DROPS TO 'SUB TRUECHAT'
  2886. '                                   THEN EXITS AFTERWARDS.
  2887. '
  2888. '
  2889. '  OUTPUTS -- NONE
  2890. '
  2891. '  PURPOSE -- To allow users to chat between nodes in several different
  2892. '             ways.
  2893. '
  2894. '      SUB CBCHAT(NodesInSystem) STATIC
  2895. '      DoTrueChat = ZFalse
  2896. '      NodesToSquelch$ = ""                      'NODES TO SQUELCH (OBVIOUSLY)
  2897. '      HasPaged = 0
  2898. '      FileName$ = "RBBSCHAT.DEF"
  2899. '      CALL FindItX (FileName$, 7)
  2900. '      IF ZOK THEN
  2901. '         HasPaged = 0
  2902. '         CurrentNodeIndex = ZNodeRecIndex - 1
  2903. '         CLOSE 7
  2904. '         CALL OpenWrk7 (FileName$)
  2905. '         FIELD 7, 1 AS ChatActivity$, _
  2906. '                  2 AS PagingNode$,   _
  2907. '                  2 AS PrivateFor$,   _
  2908. '                 72 AS ChatInput$,    _
  2909. '                 31 AS ChatName$,     _
  2910. '                  1 AS InTrueChat$
  2911. '
  2912. '         CALL UpdtCalr("Entered CB sim at " + TIME$, 1)
  2913. '         CALL QuickTPut("Type Ctrl-T to Enter TrueCh@,  Type ? for help!,", 1)
  2914. '         CALL QuickTPut("     Ctrl-W to see Who else is on, Ctrl-P for another node", 1)
  2915. '         CALL QuickTPut("Hit ESC to exit chat!", 2)
  2916. '         REDIM ChatHold$(NodesInSystem)
  2917. '
  2918. '         CALL LockIt7 (CurrentNodeIndex, ZTrue)
  2919. '         DoTrueChat = (InTrueChat$ = "Y")
  2920. '         LSET ChatActivity$ = "A"
  2921. '         LSET PrivateFor$ = MKI$(0)
  2922. '         CALL LockIt7 (CurrentNodeIndex, ZFalse)
  2923. '
  2924. '         REM ** LOAD IN CURRENT NODAL STATUS FOR LATER COMPARISON **
  2925. '         FOR LineIndex = 1 TO NodesInSystem
  2926. '            CALL LockIt7 (LineIndex, ZTrue)
  2927. '            ZUserIn$(LineIndex) = ChatActivity$
  2928. '         NEXT
  2929. '
  2930. '         ReadyToEnter = ZFalse
  2931. '         ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2932. '
  2933. '         WasA1$ = ZActiveMessageFile$
  2934. '         ZActiveMessageFile$ = ZOrigMsgFile$
  2935. '         CALL OpenMsg
  2936. '         FIELD 1, 128 AS ZMsgRec$
  2937. '
  2938. '         DO
  2939. '
  2940. '            IF DoTrueChat THEN
  2941. '               CALL TrueChat(CurrentNodeIndex, HasPaged, NodesInSystem)
  2942. '               EXIT DO
  2943. '            END IF
  2944. 'REM **************************************************************************
  2945. 'REM ******Check for answer to page, or text from other users in chat *********
  2946. 'REM **************************************************************************
  2947. '            FOR LineIndex = 1 TO NodesInSystem
  2948. '
  2949. '               SquelchIt = ZFalse
  2950. '               IF LineIndex <> CurrentNodeIndex THEN
  2951. '
  2952. '                  CALL LockIt7 (LineIndex, ZTrue)
  2953. '                  Index$ = MID$(STR$(LineIndex), 2, 1)
  2954. '
  2955. '                  REM ** CHECK TO SEE IF THIS NODE HAS BEEN SQUELCHED **
  2956. '                  IF NodesToSquelch$ <> "" THEN
  2957. '                     SquelchIt = (INSTR(NodesToSquelch$, Index$) > 0)
  2958. '                  END IF
  2959. '                  REM ** CHECK TO SEE IF OTHER NODE IN TRUE CHAT **
  2960. '                  IF NOT SquelchIt THEN
  2961. '                     SquelchIt = (InTrueChat$ = "A")
  2962. '                  END IF
  2963. '
  2964. '                  REM ** CHECK FOR ANSWER TO PAGE (IF A PAGE WAS DONE) **
  2965. '                  IF HasPaged = LineIndex THEN
  2966. '                     IF ChatActivity$ <> "R" THEN
  2967. '                        IF ChatActivity$ = "N" THEN
  2968. '                           CALL QuickTPut("Paged user probably will not enter chat mode!", 1)
  2969. '                           HasPaged = 0
  2970. '                         ELSEIF ChatActivity$ = "Y" THEN
  2971. '                           CALL QuickTPut("Paged user should be joining momentarily!", 1)
  2972. '                           HasPaged = 0
  2973. '                        END IF
  2974. '                     END IF
  2975. '                  END IF
  2976. '
  2977. '                  ChatTemp$ = ""
  2978. '                  NameTemp$ = ""
  2979. '
  2980. '                  REM ** CHECK FOR CHANGE IN NODAL ACTIVITY             **
  2981. '                  REM ** IN THIS CASE, SEE IF SOMEONE HAS LEFT THE CHAT **
  2982. '                  REM ** NODE MUST NOT BE SQUELCHED                     **
  2983. '                  IF NOT SquelchIt THEN
  2984. '                     IF (ZUserIn$(LineIndex) = "A") AND (ChatActivity$ = "I") THEN
  2985. '                        CALL QuickTPut("Node " + Index$ + " has exited chat mode!", 1)
  2986. '                     END IF
  2987. '                  REM ** OR, IF SOMEONE HAS JOINED THE CHAT **
  2988. '                     IF (ZUserIn$(LineIndex) <> "A") AND (ChatActivity$ = "A") THEN
  2989. '                        CALL QuickTPut("Node " + Index$ + " has entered the chat!", 1)
  2990. '                     END IF
  2991. '                  END IF
  2992. '
  2993. '                  REM ** SAVE NEW NODE STATUS (IF ANY) **
  2994. '                  ZUserIn$(LineIndex) = ChatActivity$
  2995. '
  2996. '                  REM ** IF OTHER NODE IS ACTIVE (& NOT SQUELCHED) CHECK IT **
  2997. '                  IF (ChatActivity$ = "A") AND (NOT SquelchIt) THEN
  2998. '
  2999. '                     GET 1, (LineIndex + 1)
  3000. '                     IF MID$(MESSAGE.RECORD$, 55, 2) = "-1" AND NOT ZSysop THEN
  3001. '                        NameTemp$ = "SYSOP"
  3002. '                      ELSE
  3003. '                        NameTemp$ = MID$(MESSAGE.RECORD$,1,26)
  3004. '                     END IF
  3005. '
  3006. '                     ChatTemp$ = ChatInput$
  3007. '                     CALL TrimTrail (ChatTemp$, " ")
  3008. '                     CALL TrimTrail (ChatHold$(LineIndex), " ")
  3009. '                     REM ** IF TEXT HAS CHANGED AND TEXT IS NOT A NULL STRING
  3010. '                     IF (ChatTemp$ <> ChatHold$(LineIndex)) AND ChatTemp$ <> "" THEN
  3011. '                        REM ** IF PUBLIC OR PRIVATE AND TO THIS NODE
  3012. '                        IF (CVI(PrivateFor$) = 0) OR (CVI(PrivateFor$) = CurrentNodeIndex) THEN
  3013. '                           CALL TrimTrail(NameTemp$, " ")
  3014. '                           ZOutTxt$ = "<" + Index$ + ">" + _
  3015. '                                      NameTemp$ + ": " + ChatTemp$
  3016. '                           CALL QuickTPut(ZOutTxt$, 1)
  3017. '                           ChatHold$(LineIndex) = ChatTemp$
  3018. '                        END IF
  3019. '                     END IF
  3020. '                  END IF
  3021. '               END IF
  3022. '            NEXT
  3023. '
  3024. 'REM **************************************************************************
  3025. 'REM *******Get text from local user (local, as in, this node of RBBS)*********
  3026. 'REM **************************************************************************
  3027. '            ZOutTxt$(0) = ""                   'chat work string
  3028. '            ReadyToEnter = ZFalse
  3029. '            IF NOT ZLocalUser THEN
  3030. '               CALL EOFComm (ZChar%)
  3031. '              ELSE
  3032. '               ZChar% = -1
  3033. '            END IF
  3034. '            IF ZChar% <> -1 THEN          'if remote key in then get complete
  3035. '               CALL GetCom(Key$)
  3036. '             ELSE
  3037. '               Key$ = INKEY$             'else check for local
  3038. '            END IF
  3039. '            IF Key$ <> "" THEN
  3040. '               IF LEN(Key$) = 1 THEN
  3041. '                  IF Key$ = ZEscape$ THEN
  3042. '                     EXIT DO
  3043. '                   ELSEIF Key$ = CHR$(13) THEN
  3044. '                     ZOutTxt$(0) = ""
  3045. '                   ELSEIF Key$ = CHR$(16) THEN
  3046. '                     CALL PageEm(CurrentNodeIndex, HasPaged, NodesInSystem, 0)
  3047. '                     IF HasPaged = -1 THEN
  3048. '                        EXIT DO
  3049. '                     END IF
  3050. '                   ELSEIF Key$ = CHR$(20) THEN
  3051. '                     CALL TrueChat(CurrentNodeIndex, HasPaged, NodesInSystem)
  3052. '                     EXIT DO
  3053. '                   ELSEIF Key$ = CHR$(23) THEN
  3054. '                     CALL PageEm(CurrentNodeIndex, HasPaged, NodesInSystem, -1)
  3055. '                   ELSEIF Key$ = CHR$(63) THEN
  3056. '                     CALL BufFile ("CHATHELP", X)
  3057. '                   ELSE
  3058. '                     ZOutTxt$(0) = Key$
  3059. '                     ReadyToEnter = ZTrue
  3060. '                  END IF
  3061. '               END IF
  3062. '            END IF
  3063. '            IF ReadyToEnter THEN
  3064. '               CALL QuickTPut("> " + ZOutTxt$(0), 0)
  3065. '               CALL LineEdit (0, 64)
  3066. '               ReadyToEnter = ZFalse
  3067. '               ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  3068. '            END IF
  3069. '
  3070. '            IF ZOutTxt$(0) <> "" THEN
  3071. '               PrivateMessage = 0
  3072. '               IF LEFT$(ZOutTxt$(0), 1) = "*" THEN
  3073. '                  PrivateMessage = VAL(MID$(ZOutTxt$(0), 2))
  3074. '                  REM ********************************************************
  3075. '                  REM ** CHECK HERE TO SEE IF PRIVATE NODE WAS SQUELCHED    **
  3076. '                  REM ** IF SO, UNSQUELCH IT.. IE: PRIVATE MSG UNSQUELCHES  **
  3077. '                  REM ** (SO TO SPEAK).                                     **
  3078. '                  REM ********************************************************
  3079. '                  IF NodesToSquelch$ <> "" THEN
  3080. '                     Squelched = INSTR(NodesToSquelch$, MID$(ZOutTxt$(0), 2, 1))
  3081. '                     IF Squelched = 1 THEN
  3082. '                        IF LEN(NodesToSquelch$) = 1 THEN
  3083. '                           NodesToSquelch$ = ""
  3084. '                         ELSE
  3085. '                           NodesToSquelch$ = MID$ (NodesToSquelch$, Squelched + 1)
  3086. '                        END IF
  3087. '                     ELSEIF Squelched > 1 THEN
  3088. '                        NodesToSquelch$ = LEFT$(NodesToSquelch$, Squelched - 1) + _
  3089. '                                            MID$ (NodesToSquelch$, Squelched + 1)
  3090. '                     END IF
  3091. '                     IF Squelched > 0 THEN
  3092. '                        CALL QuickTPut("Node " + MID$(ZOutTxt$(0), 2, 1) + " has been UNsquelched!", 1)
  3093. '                     END IF
  3094. '                  END IF
  3095. '                  IF LEN(ZOutTxt$(0)) > 2 THEN
  3096. '                     ZOutTxt$(0) = MID$(ZOutTxt$(0), 3)
  3097. '                   ELSE
  3098. '                     ZOutTxt$(0) = ""
  3099. '                  END IF
  3100. '                REM ** ADD NODE TO SQUELCH LIST **
  3101. '                ELSEIF LEFT$(ZOutTxt$(0), 1) = "!" THEN
  3102. '                  NodesToSquelch$ = NodesToSquelch$ + MID$(ZOutTxt$(0), 2, 1)
  3103. '                  CALL QuickTPut("Node " + MID$(ZOutTxt$(0), 2, 1) + " has been squelched!", 1)
  3104. '                  IF LEN(ZOutTxt$(0)) > 2 THEN
  3105. '                     ZOutTxt$(0) = MID$(ZOutTxt$(0), 3)
  3106. '                   ELSE
  3107. '                     ZOutTxt$(0) = ""
  3108. '                  END IF
  3109. '               END IF
  3110. '               ChatHold$(CurrentNodeIndex) = ZOutTxt$(0) + SPACE$(72 - LEN(ZOutTxt$(0)))
  3111. '               CALL LockIt7 (CurrentNodeIndex, ZTrue)
  3112. '               LSET ChatInput$ = ChatHold$(CurrentNodeIndex)
  3113. '               IF PrivateMessage THEN
  3114. '                  LSET PrivateFor$ = MKI$(PrivateMessage)  'PRIVATE
  3115. '                ELSE
  3116. '                  LSET PrivateFor$ = MKI$(0)  'PUBLIC
  3117. '               END IF
  3118. '               CALL LockIt7 (CurrentNodeIndex, ZFalse)
  3119. '            END IF
  3120. '
  3121. '            CALL CheckCarrier
  3122. '            IF ZSubParm = -1 THEN
  3123. '               EXIT DO
  3124. '            END IF
  3125. '            CALL CheckTimeRemain(MinsRemaining)
  3126. '            IF ZSubParm = -1 THEN
  3127. '               EXIT DO
  3128. '            END IF
  3129. '            CALL CheckTime(ZAutoLogoff!, TempElapsed!, 1)
  3130. '            IF TempElapsed! <=0 THEN
  3131. '               ZWaitExpired = ZTrue
  3132. '               EXIT DO
  3133. '            END IF
  3134. '
  3135. '         LOOP
  3136. '         CALL LockIt7 (CurrentNodeIndex, ZTrue)
  3137. '         LSET ChatInput$ = SPACE$(72)
  3138. '         LSET ChatActivity$ = "I"
  3139. '         CALL LockIt7 (CurrentNodeIndex, ZFalse)
  3140. '         CLOSE 7
  3141. '      END IF
  3142. '      ZActiveMessageFile$ = WasA1$
  3143. '      END SUB
  3144. '
  3145. '63580 ' $SUBTITLE: 'PageEm - attempt to page another user to chat'
  3146. ' $PAGE
  3147. '
  3148. '  NAME    -- PageEm
  3149. '
  3150. '  INPUTS  -- SHOW.ONLY        Show whos is on the other nodes only
  3151. '             NodesInSystem  Number of nodes in this system
  3152. '
  3153. '  OUTPUTS -- HasPaged        -1 exit chat mode
  3154. '                               0 don't check for reply to page
  3155. '                               1 - NodesInSystem check for page reply
  3156. '
  3157. '  PURPOSE -- Page another user on the system and set up for a reply
  3158. '             from the other user
  3159. '
  3160. '      SUB PageEm(CurrentNodeIndex, HasPaged, NodesInSystem, ShowOnly) STATIC
  3161. '      CALL WhosOn (NodesInSystem)
  3162. '      CALL SkipLine(1)
  3163. '      IF ShowOnly THEN
  3164. '         EXIT SUB
  3165. '      END IF
  3166. '      ZOutTxt$ = "Which node do you wish to page (1 -" + STR$(NodesInSystem) + ")" + PRESS.ENTER$
  3167. '      ZSubParm = 1
  3168. '      CALL TGet
  3169. '      IF ZWasQ = 0 THEN
  3170. '         HasPaged = -1
  3171. '         EXIT SUB
  3172. '      END IF
  3173. '      CALL CheckInt(ZUserIn$(1))
  3174. '      FIELD 7, 1 AS ChatActivity$, _
  3175. '               2 AS PagingNode$,   _
  3176. '               2 AS PrivateFor$,   _
  3177. '              72 AS ChatInput$,    _
  3178. '              31 AS ChatName$,     _
  3179. '               1 AS InTrueChat$
  3180. '      IF ZTestedIntValue > 0 AND ZTestedIntValue <= NodesInSystem AND _
  3181. '         ZTestedIntValue <> CurrentNodeIndex THEN
  3182. '         CALL QuickTPut("Hang on,  I'll let them know you wanna chat", 1)
  3183. '         CALL QuickTPut("If you don't get an answer within a couple minutes,", 1)
  3184. '         CALL QuickTPut("then you probably won't get an a answer", 1)
  3185. '         CALL LockIt7 (ZTestedIntValue, ZTrue)
  3186. '         IF ChatActivity$ = "A" THEN        'if other node already
  3187. '            IF InTrueChat$ = "A" THEN         'can't page 'em if in true chat
  3188. '               CALL QuickTPut("The node you requested is in a private chat!", 1)
  3189. '               HasPaged = -1
  3190. '             ELSE
  3191. '               HasPaged = 0
  3192. '            END IF
  3193. '            EXIT SUB
  3194. '         END IF
  3195. '         LSET ChatActivity$ = "R"           'R means Request
  3196. '         LSET PagingNode$ = MKI$(CurrentNodeIndex)
  3197. '         HasPaged = ZTestedIntValue
  3198. '         CALL LockIt7 (ZTestedIntValue, ZFalse)
  3199. '       ELSE
  3200. '         HasPaged = -1
  3201. '      END IF
  3202. '      END SUB
  3203. '
  3204. '63590 ' $SUBTITLE: 'TrueChat - internode normal chat emulator'
  3205. ' $PAGE
  3206. '
  3207. '  NAME    -- TrueChat
  3208. '
  3209. '  INPUTS  -- NodesInSystem  Number of nodes in this system
  3210. '
  3211. '  OUTPUTS -- HasPaged         -1 exit chat mode
  3212. '                               0 don't check for reply to page
  3213. '                               1 > NodesInSystem check for page reply
  3214. '
  3215. '  PURPOSE -- Page another user on the system and set up for a reply
  3216. '             from the other user
  3217. '
  3218. '      SUB TrueChat(CurrentNodeIndex, HasPaged, NodesInSystem) STATIC
  3219. '      PrivateFrom = 0
  3220. '      OtherNodeStatus$ = "I"
  3221. '      TrueChatIndexSave! = 0
  3222. '      OtherNodeInput$ = ""
  3223. '      FIELD 7, 1 AS ChatActivity$, _
  3224. '               2 AS PagingNode$,   _
  3225. '               2 AS PrivateFor$,   _
  3226. '              72 AS ChatInput$,    _
  3227. '              31 AS ChatName$,     _
  3228. '               1 AS InTrueChat$,   _
  3229. '               4 AS TrueChatIndex$
  3230. '      CALL LockIt7 (CurrentNodeIndex, ZTrue)
  3231. '      REM ** IF NOT ANSWERING A PAGE THEN... **
  3232. '      IF InTrueChat$ <> "Y" THEN
  3233. '         CALL PageEm(CurrentNodeIndex, HasPaged, NodesInSystem, 0)
  3234. '         IF HasPaged < 1 THEN
  3235. '            EXIT SUB
  3236. '         END IF
  3237. '       ELSE
  3238. '         HasPaged = CVI(PagingNode$)
  3239. '      END IF
  3240. '      CALL QuickTPut("TRUECh@ (TrueChat) mode!", 1)
  3241. '      CALL LockIt7 (CurrentNodeIndex, ZTrue)
  3242. '      LSET InTrueChat$ = "A"                     'TRUE CHAT MODE.. 2 NODES ONLY
  3243. '      LSET TrueChatIndex$ = MKS$(0)
  3244. '      CALL LockIt7 (CurrentNodeIndex, ZFalse)
  3245. '      PrivateFrom = HasPaged
  3246. '      ZCol = 0
  3247. '      SendRemote = ZRemoteEcho
  3248. '
  3249. '      DO
  3250. '
  3251. '         CALL LockIt7 (PrivateFrom, ZTrue)
  3252. '
  3253. '         IF HasPaged = PrivateFrom THEN
  3254. '            IF ChatActivity$ <> "R" THEN
  3255. '               IF ChatActivity$ = "N" THEN
  3256. '                  CALL QuickTPut("Paged user will probably NOT enter TRUECh@!", 1)
  3257. '                  HasPaged = 0
  3258. '                ELSEIF ChatActivity$ = "Y" THEN
  3259. '                  CALL QuickTPut("Paged user should be TRUECh@ing momentarily!", 1)
  3260. '                  HasPaged = 0
  3261. '               END IF
  3262. '            END IF
  3263. '         END IF
  3264. '
  3265. '         REM ** CHECK TO SEE IF THE OTHER GUY HAS ENTERED TRUECH@ **
  3266. '         IF OtherNodeStatus$ <> "A" AND InTrueChat$ = "A" THEN
  3267. '            CALL QuickTPut("The other user has joined TRUECh@!", 1)
  3268. '         END IF
  3269. '
  3270. '         REM ** SINCE ITS A PRIVATE CHAT. WE'LL EXIT ALONG WITH OTHER DUDE **
  3271. '         IF OtherNodeStatus$ = "A" AND InTrueChat$ = "I" THEN
  3272. '            CALL QuickTPut("The other user has exited TRUECh@!", 1)
  3273. '            EXIT DO
  3274. '         END IF
  3275. '
  3276. '         OtherNodeStatus$ = InTrueChat$
  3277. '         OtherNodeInput$  = LEFT$(ChatInput$, 1)
  3278. '
  3279. '         IF (CVS(TrueChatIndex$) > TrueChatIndexSave!) AND _
  3280. '            OtherNodeStatus$ = "A" THEN
  3281. '            IF OtherNodeInput$ = CHR$(8) THEN
  3282. '               CALL LPrnt(ZLocalBkSp$, 0)
  3283. '               IF SendRemote THEN
  3284. '                  CALL PutCom (ZBackSpace$)
  3285. '               END IF
  3286. '               ZCol = ZCol - 1
  3287. '             ELSEIF OtherNodeInput$ = ZCarriageReturn$ THEN
  3288. '               IF SendRemote THEN
  3289. '                  CALL PutCom(ZCarriageReturn$)
  3290. '               END IF
  3291. '               IF SendRemote AND ZLineFeeds THEN
  3292. '                  CALL PutCom(ZLineFeed$)
  3293. '               END IF
  3294. '               CALL LPrnt(ZCarriageReturn$, 0)
  3295. '               ZCol = 1
  3296. '             ELSE
  3297. '               IF SendRemote THEN
  3298. '                  CALL PutCom(OtherNodeInput$)
  3299. '               END IF
  3300. '               CALL LPrnt (OtherNodeInput$, 0)
  3301. '               ZCol = ZCol + 1
  3302. '            END IF
  3303. '            TrueChatIndexSave! = CVS(TrueChatIndex$)
  3304. '          ELSE
  3305. '            Key$ = ""
  3306. '            IF NOT ZLocalUser THEN
  3307. '               CALL EOFComm (ZChar%)
  3308. '              ELSE
  3309. '               ZChar% = -1
  3310. '            END IF
  3311. '            IF ZChar% <> -1 THEN          'if remote key in then get complete
  3312. '               CALL GetCom(Key$)
  3313. '              ELSE
  3314. '               Key$ = INKEY$
  3315. '            END IF
  3316. '            IF Key$ <> "" THEN
  3317. '               IF LEN(Key$) = 1 THEN
  3318. '                  IF Key$ = ZEscape$ THEN
  3319. '                     EXIT DO
  3320. '                   ELSE
  3321. '                     CALL LockIt7(CurrentNodeIndex, ZTrue)
  3322. '                     LSET ChatInput$ = Key$
  3323. '                     LSET TrueChatIndex$ = MKS$(CVS(TrueChatIndex$) + 1)
  3324. '                     CALL LockIt7(CurrentNodeIndex, ZFalse)
  3325. '                     IF Key$ <> CHR$(8) THEN
  3326. '                        CALL QuickTPut(Key$, 0)
  3327. '                      ELSE
  3328. '                        CALL LPrnt(ZLocalBkSp$, 0)
  3329. '                        IF (NOT ZLocalUser) AND SendRemote THEN
  3330. '                           CALL PutCom (ZBackSpace$)
  3331. '                        END IF
  3332. '                        ZCol = ZCol - 2
  3333. '                     END IF
  3334. '                     IF Key$ = ZCarriageReturn$ THEN
  3335. '                        IF SendRemote AND ZLineFeeds THEN
  3336. '                           CALL PutCom(ZLineFeed$)
  3337. '                        END IF
  3338. '                        ZCol = 0
  3339. '                     END IF
  3340. '                     ZCol = ZCol + 1
  3341. '                  END IF
  3342. '               END IF
  3343. '            END IF
  3344. '         END IF
  3345. '
  3346. '         IF ZCol > 72 THEN
  3347. '            CALL QuickTPut(ZCarriageReturn$, 0)
  3348. '            ZCol = 1
  3349. '         END IF
  3350. '
  3351. '      LOOP
  3352. '
  3353. '      CALL LockIt7 (CurrentNodeIndex, ZTrue)
  3354. '      LSET InTrueChat$ = "I"
  3355. '      LSET ChatInput$ = SPACE$(72)
  3356. '      CALL LockIt7 (CurrentNodeIndex, ZFalse)
  3357. '
  3358. '      END SUB
  3359. '
  3360. '
  3361. '
  3362. '******************** INSERTED AutoLogoff here ******************
  3363. '
  3364. ' $SUBTITLE: 'AutoLogOff - Subroutine to  to log off after transfer'
  3365. ' $PAGE
  3366. '
  3367.   SUB AutoLogOff STATIC
  3368.  ZAutoEnd = 0
  3369.   IF ZGetExtDesc = ZTrue THEN _
  3370.     EXIT SUB
  3371.  ZSubParm = 1
  3372.    ZOutTxt$ = CHR$(7)+ZFG1$+"Auto-"+_
  3373.         ZFG3$+"LogOff"+ZFG1$+" after the transfer "+ZEmphasizeOff$ +CHR$(7)
  3374. CALL QuickTPut(ZOutTxt$,0)
  3375.     ZOutTxt$ = "(Y,[N])"
  3376.     ZTurboKey = -ZTurboKeyUser
  3377.       CALL TGet
  3378.        IF NOT ZYes THEN _
  3379.      CALL SkipLine (1) : _
  3380.      EXIT SUB 
  3381.  ZAutoEnd = 1
  3382.  CALL SkipLine (1)
  3383. END SUB
  3384.